{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | The free 'Cfg'
module Data.Cfg.FreeCfg
  ( FreeCfg(..)
  , toFreeCfg
  ) where

import Data.Cfg.Cfg (Cfg(..), Vs)
import qualified Data.Set as S

-- | Represents a context-free grammar with its nonterminal and
-- terminal types.  The canonical instance of 'Cfg': a record that
-- collects up implementations of each class method.
data FreeCfg t nt = FreeCfg
  { FreeCfg t nt -> Set nt
nonterminals' :: S.Set nt
    -- ^ the nonterminals of the grammar
  , FreeCfg t nt -> Set t
terminals' :: S.Set t
    -- ^ the terminals of the grammar
  , FreeCfg t nt -> nt -> Set (Vs t nt)
productionRules' :: nt -> S.Set (Vs t nt)
    -- ^ the productions of the grammar
  , FreeCfg t nt -> nt
startSymbol' :: nt
    -- ^ the start symbol of the grammar; must be an element of
    -- 'nonterminals' 'cfg'
  }

instance Cfg FreeCfg t nt where
  nonterminals :: FreeCfg t nt -> Set nt
nonterminals = FreeCfg t nt -> Set nt
forall t nt. FreeCfg t nt -> Set nt
nonterminals'
  terminals :: FreeCfg t nt -> Set t
terminals = FreeCfg t nt -> Set t
forall t nt. FreeCfg t nt -> Set t
terminals'
  productionRules :: FreeCfg t nt -> nt -> Set (Vs t nt)
productionRules = FreeCfg t nt -> nt -> Set (Vs t nt)
forall t nt. FreeCfg t nt -> nt -> Set (Vs t nt)
productionRules'
  startSymbol :: FreeCfg t nt -> nt
startSymbol = FreeCfg t nt -> nt
forall t nt. FreeCfg t nt -> nt
startSymbol'

-- | Converts any 'Cfg' into a 'FreeCfg'.
toFreeCfg :: Cfg cfg t nt => cfg t nt -> FreeCfg t nt
toFreeCfg :: cfg t nt -> FreeCfg t nt
toFreeCfg cfg t nt
cfg =
  FreeCfg :: forall t nt.
Set nt -> Set t -> (nt -> Set (Vs t nt)) -> nt -> FreeCfg t nt
FreeCfg
    { nonterminals' :: Set nt
nonterminals' = cfg t nt -> Set nt
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> Set nt
nonterminals cfg t nt
cfg
    , terminals' :: Set t
terminals' = cfg t nt -> Set t
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> Set t
terminals cfg t nt
cfg
    , productionRules' :: nt -> Set (Vs t nt)
productionRules' = cfg t nt -> nt -> Set (Vs t nt)
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> nt -> Set (Vs t nt)
productionRules cfg t nt
cfg
    , startSymbol' :: nt
startSymbol' = cfg t nt -> nt
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> nt
startSymbol cfg t nt
cfg
    }