content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE RankNTypes #-}
  module Data.TreeGrammar.NonTerminal(NonTerminal(..),fresh',Named,getName) where
  
  import Control.Monad.State
  
  import Data.Hashable
  import Data.Kind
  import Data.Text(Text,pack,unpack)
  
  import Text.Printf
  
  class Show n => NonTerminal n where
    type Gen n
    fresh :: Maybe String -> State (Gen n) n
    generate :: forall (g :: Type -> (Type -> Type) -> Type) t.
                State (Gen n) (g n t) -> g n t
  
  instance NonTerminal Int where
    type Gen Int = Int
    fresh _ = do
      x <- get
      put (x+1)
      return x
    generate f = evalState f 0
  
  data Named = Named (Maybe Text) Int
  getName :: Named -> Text
  getName (Named (Just n) _) = n
  getName (Named _ n) = pack (show n)
  
  instance Eq Named where
    Named _ n == Named _ m = n == m
  instance Hashable Named where
    hashWithSalt s (Named _ n) = hashWithSalt s n
  instance Show Named where
    show (Named (Just n) _) = printf "%s" (unpack n)
    show (Named Nothing m) = show m
  
  instance NonTerminal Named where
    type Gen Named = Int
    fresh m = do
      n <- fresh m
      return (Named (pack <$> m) n)
    generate f = evalState f 0
  
  fresh' :: NonTerminal n => Maybe String -> State (Gen n,x) n
  fresh' s = state (\(i,x) -> let (f,i') = runState (fresh s) i in (f,(i',x)))
  