madlang 3.0.0.3 → 3.0.0.4

raw patch · 7 files changed

+30/−10 lines, 7 filesdep +th-lift-instances

Dependencies added: th-lift-instances

Files

madlang.cabal +2/−1
src/Text/Madlibs.hs +2/−0
src/Text/Madlibs/Ana/ParseUtils.hs +7/−3
src/Text/Madlibs/Ana/Resolve.hs +2/−1
src/Text/Madlibs/Generate/TH.hs +5/−0
src/Text/Madlibs/Internal/Types.hs +7/−4
test/Demo.hs +5/−1

madlang.cabal view

@@ -1,5 +1,5 @@ name:                madlang-version:             3.0.0.3+version:             3.0.0.4 synopsis:            Randomized templating language DSL description:         Madlang is a text templating language written in Haskell,                      meant to explore computational creativity and generative@@ -72,6 +72,7 @@                      , ansi-wl-pprint                      , containers                      , titlecase+                     , th-lift-instances                      , http-client                      , tar                      , zlib

src/Text/Madlibs.hs view

@@ -31,6 +31,7 @@                     , run                     , runText                     , RandTok (..)+                    , Key                     -- * Types associated with the parser                     , Context                     , SemanticError (..)@@ -39,6 +40,7 @@                     -- * Template Haskell EDSL                     , madlang                     , madFile+                    , madEmbed                     ) where  import           Text.Madlibs.Ana.Parse

src/Text/Madlibs/Ana/ParseUtils.hs view

@@ -18,7 +18,7 @@ import           Data.Foldable import           Data.List import qualified Data.Map                    as M-import           Data.Maybe                  (catMaybes, fromJust)+import           Data.Maybe                  (catMaybes) import           Data.Monoid import qualified Data.Text                   as T import           Data.Text.Titlecase@@ -110,9 +110,13 @@     where isPreTok PreTok{} = True           isPreTok _        = False +maybeList :: Maybe [a] -> [a]+maybeList (Just x) = x+maybeList Nothing  = []+ allDeps :: [(Key, [(Prob, [PreTok])])] -> Key -> [Key]-allDeps context key = let deps = (catMaybes . fmap maybeName . getNames) context in deps <> (allDeps context =<< deps)-    where getNames = (=<<) snd . fromJust . lookup key+allDeps context key = let deps = (maybeList . fmap (catMaybes . (fmap maybeName)) . getNames) context in deps <> (allDeps context =<< deps)+    where getNames = fmap ((=<<) snd) . lookup key           maybeName (Name n _) = Just n           maybeName _          = Nothing

src/Text/Madlibs/Ana/Resolve.hs view

@@ -5,7 +5,8 @@     parseFile   , runFile   , makeTree-  , runText ) where+  , runText+  , getInclusionCtx ) where  import           Control.Arrow               (first) import           Control.Composition

src/Text/Madlibs/Generate/TH.hs view

@@ -4,6 +4,7 @@ module Text.Madlibs.Generate.TH     ( madFile     , madlang+    , madEmbed     ) where  import           Data.FileEmbed@@ -13,6 +14,7 @@ import           Language.Haskell.TH         hiding (Dec) import           Language.Haskell.TH.Quote import           Text.Madlibs.Ana.Parse+import           Text.Madlibs.Ana.Resolve import           Text.Madlibs.Internal.Utils import           Text.Megaparsec @@ -47,6 +49,9 @@ -- | Turn a parse error into an error that will be caught when Template Haskell compiles at runtime. errorgen :: Either (ParseError Char (ErrorFancy Void)) a -> a errorgen = either (error . T.unpack . show') id++madEmbed :: FilePath -> FilePath -> Q Exp+madEmbed folder filepath = [| errorgen <$> runIO (getInclusionCtx False [] folder filepath) |]  -- | Splice for embedding a '.mad' file, e.g. --

src/Text/Madlibs/Internal/Types.hs view

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveFoldable       #-} {-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE DeriveLift           #-} {-# LANGUAGE DeriveTraversable    #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE OverloadedStrings    #-}@@ -10,12 +11,14 @@ -- | Module with the type of a random token module Text.Madlibs.Internal.Types where -import           Control.Arrow            (second)+import           Control.Arrow              (second) import           Control.Monad.State import           Data.Function-import           Data.Functor.Foldable.TH (makeBaseFunctor)+import           Data.Functor.Foldable.TH   (makeBaseFunctor) import           Data.Monoid-import qualified Data.Text                as T+import qualified Data.Text                  as T+import           Instances.TH.Lift          ()+import           Language.Haskell.TH.Syntax (Lift (..))  -- | datatype for a double representing a probability type Prob = Double@@ -37,7 +40,7 @@  -- | datatype for a token returning a random string data RandTok = List [(Prob, RandTok)] | Value T.Text-    deriving (Show, Eq)+    deriving (Show, Eq, Lift)  apply :: (T.Text -> T.Text) -> RandTok -> RandTok -- TODO make a base functor so we can map f over stuff? apply f (Value str) = Value (f str)

test/Demo.hs view

@@ -11,13 +11,17 @@ demo :: RandTok demo = $(madFile "test/templates/gambling.mad") +-- demoDir :: [(Key, RandTok)]+-- demoDir = $(madEmbed "test/templates" "gambling.mad")+ demoQQ :: RandTok demoQQ = [madlang| :define something     1.0 "hello"     1.0 "goodbye" :return-    1.0 something|]+    1.0 something+|]  runTest :: IO T.Text runTest = run demo