{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}

module Parser.ProductRule.Internal.Manager where

import Parser.ProductRule.Internal.Maker
import Control.Monad.Writer (Writer(..), runWriter, tell, MonadWriter(..))
import Parser.ProductRule.Internal
import Data.Set (Set)
import qualified Data.Set as S (fromList)
import Control.Monad (mzero)


newtype Manager' a x = Manager {
      unManager :: Writer [Maker a] x
   } deriving (Functor, Applicative, Monad, MonadWriter [Maker a])

type Manager a = Manager' a ()


getMakers :: Manager a -> [Maker a]
getMakers m = snd $ runWriter $ unManager m


addMakers :: [Maker a] -> Manager a -> Manager a
addMakers ls m = m >> tell ls


empty :: Manager a
empty = Manager $ tell []


singleton :: Maker a -> Manager a
singleton a = addMakers [a] empty


getRules :: (Ord a) => Manager a -> Set a -> [ProductRule a]
getRules a nts = do
   maker <- getMakers a
   let (lhs, rhs) = unMaker maker
   rs <- rhs
   return $ rule lhs $ reverse $ map (`setT` nts) rs


getNTs :: (Ord a) => Manager a -> Set a
getNTs a = S.fromList $ do
   make <- getMakers a
   case unMaker make of
      (NT x, _) -> return x
      _ -> mzero


-- | Collect the defined syntax and produces a list of production rules.
productRules :: (Ord a) => Manager a -> [ProductRule a]
productRules a = getRules a $ getNTs a


instance FromMaker Manager' where
   fromMaker = singleton