madlang 2.4.1.2 → 2.4.1.3

raw patch · 5 files changed

+16/−35 lines, 5 filesdep ~basedep ~megaparsec

Dependency ranges changed: base, megaparsec

Files

• madlang.cabal +1/−1
• src/Text/Madlibs/Cata/Run.hs +5/−4
• src/Text/Madlibs/Cata/SemErr.hs +5/−25
• src/Text/Madlibs/Internal/Types.hs +4/−4
• src/Text/Madlibs/Internal/Utils.hs +1/−1

@@ -1,5 +1,5 @@ name:                madlang-version:             2.4.1.2+version:             2.4.1.3 synopsis:            Randomized templating language DSL description:         Madlang is a text templating language written in Haskell,                      meant to explore computational creativity and generative

@@ -15,14 +15,15 @@ --     run exampleTok -- @ run :: (MonadRandom m) => RandTok -> m T.Text-run tok@(List rs) = do+run tok@List{} = do     value <- getRandomR (0,1)     let ret = ((snd . head) . filter ((>=value) . fst)) $ mkCdf tok     case ret of-        (Value txt)   -> pure txt-        tok@(List rs) -> run tok+        (Value txt)    -> pure txt+        tokNest@List{} -> run tokNest run (Value txt) = pure txt  -- | Helper function to compute the cdf when we have a pdf mkCdf :: RandTok -> [(Double, RandTok)]-mkCdf (List rs) = zip (cdf . (map fst) $ rs) (map snd rs)+mkCdf (List rs) = zip (cdf . map fst $ rs) (map snd rs)+mkCdf v@Value{} = [(1, v)]

@@ -12,15 +12,11 @@  import           Control.Exception import           Control.Monad-import qualified Data.Set                     as S import qualified Data.Text                    as T import           Data.Typeable import           Data.Void import           Text.Madlibs.Internal.Types-import           Text.Madlibs.Internal.Utils import           Text.Megaparsec-import           Text.Megaparsec.Char-import           Text.Megaparsec.Error import           Text.PrettyPrint.ANSI.Leijen  type Parser = Parsec (ErrorFancy Void) T.Text@@ -51,21 +47,10 @@ noReturn :: Parser a noReturn = showCustomError NoReturn -noContext :: T.Text -> Parser a-noContext f1 = showCustomError $ NoContext f1---- | Throws argument for circular function calls-circularFunctionCalls :: T.Text -> T.Text -> Parser a-circularFunctionCalls f1 f2 = showCustomError $ CircularFunctionCalls f1 f2- -- | Throws error when a function is defined twice doubleDefinition :: T.Text -> Parser a doubleDefinition f = showCustomError $ DoubleDefinition f --- | Throws error for insufficient arguments-insufficientArgs :: Int -> Int -> Parser a-insufficientArgs i j = showCustomError $ InsufficientArgs i j- -- | Constant to start `SemanticError`s semErrStart :: Doc semErrStart = dullred (text "\n  Semantic Error: ")@@ -82,19 +67,14 @@           name (Name str _) = str           name (PreTok _)   = "Return" --- | helper to filter out stuff that doesn't-sumProb :: [(Prob, [PreTok])] -> Bool-sumProb = ((==1) . sum . (map fst))---check for approximation too- -- | Take the head of the list, or throw the appropriate error given which functions we are trying to call. head' :: T.Text -> T.Text -> [a] -> a-head' _ _ (x:xs) = x-head' f1 f2 _    = throw (CircularFunctionCalls f1 f2)+head' _ _ (x:_) = x+head' f1 f2 _   = throw (CircularFunctionCalls f1 f2)  headNoReturn :: [a] -> a-headNoReturn (x:xs) = x-headNoReturn _      = throw NoReturn+headNoReturn (x:_) = x+headNoReturn _     = throw NoReturn  -- | Access argument, or throw error if the list is too short. access :: [a] -> Int -> a@@ -111,7 +91,7 @@ -- | Checks that we have at most one `:return` template in the file singleInstance :: Key -> [(Key, [(Prob, [PreTok])])] -> Bool singleInstance key = singleton . (filter ((==key) . fst))-    where singleton [a] = True+    where singleton [_] = True           singleton _   = False  -- | Checks that there are no instances of a key

@@ -24,9 +24,9 @@     show (PreTok t) = show t  instance Eq PreTok where-    (==) (Name a _) (PreTok b) = False     (==) (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  -- | datatype for a token returning a random string data RandTok = List [(Prob, RandTok)] | Value T.Text@@ -43,9 +43,9 @@ 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 (mappend v)) l2-    mappend l@(List l1) (List l2) = List [ (p, l `mappend` tok) | (p,tok) <- l2 ]+    mappend (List l1) v@Value{} = List $ map (over _2 (`mappend` v)) l1+    mappend v@Value{} (List l2) = List $ map (over _2 (mappend v)) l2+    mappend l@List{} (List l2) = List [ (p, l `mappend` tok) | (p,tok) <- l2 ]  -- TODO make this a map instead of keys for faster parse. -- | State monad providing context, i.e. function we've already called before

@@ -49,7 +49,7 @@  -- | Strip a pre-token's name unTok :: PreTok -> T.Text-unTok (PreTok txt) = ""+unTok PreTok{}     = "" unTok (Name txt _) = txt  -- | Read a file in as a `Text`