module Text.Madlibs.Internal.Types where
import qualified Data.Text as T
import Control.Monad.State
import Data.Functor.Identity
import Lens.Micro
import Data.Function
import Data.Monoid
import Data.Tree
type Prob = Double
type Key = T.Text
data PreTok = Name T.Text (T.Text -> T.Text) | PreTok T.Text
data RandTok = List [(Prob, RandTok)] | Value T.Text
deriving (Show, Eq)
apply :: (T.Text -> T.Text) -> RandTok -> RandTok
apply f (Value str) = Value (f str)
apply f (List l) = List $ map (over _2 (apply f)) l
tokToTree :: Prob -> RandTok -> Tree String
tokToTree p (Value a) = Node ((take 4 . show . min 1.0) p ++ " " ++ show a) []
tokToTree p (List [(_,Value a)]) = Node ((take 4 . show . min 1.0) p ++ " " ++ show a) []
tokToTree p (List xs) = Node (take 4 . show . min 1.0 $ p) (map (uncurry tokToTree) xs)
instance Monoid RandTok where
mempty = Value ""
mappend (Value v1) (Value v2) = Value (T.append v1 v2)
mappend (List l1) v@(Value v1) = List $ map (over (_2) (`mappend` v)) l1
mappend v@(Value v2) (List l2) = List $ map (over (_2) (v `mappend`)) l2
mappend l@(List l1) (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 []))