module Text.Madlibs.Internal.Types where
import Control.Arrow (second)
import Control.Monad.State
import Data.Function
import Data.Functor.Foldable.TH (makeBaseFunctor)
import Data.Monoid
import qualified Data.Text as T
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
type Prob = Double
type Key = T.Text
data PreTok = Name T.Text (T.Text -> T.Text) | PreTok T.Text
instance Show PreTok where
show (Name t _) = show ("lambda: " <> t)
show (PreTok t) = show t
instance Eq PreTok where
(==) (Name a1 f1) (Name a2 f2) = a1 == a2 && (f1 . T.pack $ ['a'..'z']) == (f2 . T.pack $ ['a'..'z'])
(==) (PreTok a) (PreTok b) = a == b
(==) _ _ = False
data RandTok = List [(Prob, RandTok)] | Value T.Text
deriving (Show, Eq, Lift)
apply :: (T.Text -> T.Text) -> RandTok -> RandTok
apply f (Value str) = Value (f str)
apply f (List l) = List $ fmap (second (apply f)) l
instance Monoid RandTok where
mempty = Value ""
mappend (Value v1) (Value v2) = Value (T.append v1 v2)
mappend (List l1) v@Value{} = List $ fmap (second (`mappend` v)) l1
mappend v@Value{} (List l2) = List $ fmap (second (mappend v)) l2
mappend l@List{} (List l2) = List [ (p, l `mappend` tok) | (p,tok) <- l2 ]
type Context a = State [(Key, RandTok)] a
instance (Eq a) => Eq (Context a) where
(==) = on (==) (flip evalState [])
makeBaseFunctor ''RandTok