madlang 3.2.0.0 → 3.2.0.1

raw patch · 6 files changed

+48/−20 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +34/−4
• madlang.cabal +1/−1
• src/Text/Madlibs/Ana/Resolve.hs +1/−1
• src/Text/Madlibs/Generate/TH.hs +10/−9
• test/Demo.hs +1/−4
• test/Spec.hs +1/−1

@@ -6,9 +6,8 @@ This is the Madlang DSL for generating text. You specify a template, and Madlang will create randomized text from the template. -Madlang is an interpreted language, written in Haskell. The primary way to use-Madlang is on the command line using the interpreter, but there is also a partially completed library-and EDSL.+Madlang is an interpreted language, written in Haskell. Madlang can be used as+an EDSL for Haskell or using the command-line interpreter.  Madlang is intended to explore computational creativity and provide an easy way to get started with generative literature.@@ -165,10 +164,41 @@     1.0 "On my walk today I saw a " weirdDog "." ``` +### EDSL++You can use Madlang as a Haskell EDSL, generating values of type `RandTok`.+This can be done a couple ways. One is to use the file embedder:++```haskell+randomText :: RandTok+randomText = $(madFile "mad-src/some-bot.mad")+```++While the other is to use the `madlang` quasi-quoter:++```haskell+randomText :: RandTok+randomText = [madlang|+:include adjectives.mad++:return+    1.0 "I am feeling very " adjectives-adjective " today."+|]+```++You can then transform this into a random text file with:++```haskell+generateText :: IO Text+generateText = run randomText+```+ ### Examples  There is a Shakespearean insult generator available to test out at [my-site](http://blog.vmchale.com/madlang).+site](http://blog.vmchale.com/madlang). For a look at using Madlang as an EDSL,+check out my [recursion scheme+generator](https://github.com/vmchale/recursion-schemata)  ## Tooling 

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

@@ -40,7 +40,7 @@ -- | Generate text from file with inclusions getInclusionCtx :: (MonadIO m) => Bool -> [T.Text] -> FilePath -> FilePath -> m (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]) getInclusionCtx isTree ins folder filepath = liftIO $ do-    libDir <- do { home <- getEnv "HOME" ; if os /= home then pure (home <> "/.madlang/") else pure (home <> "\\.madlang\\") }+    libDir <- do { home <- getEnv "HOME" ; if os /= "windows" then pure (home <> "/.madlang/") else pure (home <> "\\.madlang\\") }     file <- catch (readFile' (folder ++ filepath)) (const (readLibFile (libDir <> folder <> filepath)) :: IOException -> IO T.Text)     let filenames = map T.unpack $ either (error . show) id $ parseInclusions filepath file -- TODO pass up errors correctly     let resolveKeys file' = fmap (first (((T.pack . (<> "-")) . dropExtension) file' <>))

@@ -23,6 +23,7 @@ import           System.Directory            (doesFileExist) import           System.Environment          (getEnv) import           Text.Madlibs.Ana.Parse+import           Text.Madlibs.Ana.Resolve    (pathSep) import           Text.Madlibs.Internal.Types (Key, RandTok) import           Text.Madlibs.Internal.Utils import           Text.Megaparsec@@ -59,7 +60,7 @@ textToExpression txt = do     parse' <- [|parseTokInternal "haskell quasi-quote" []|]     inclusions <- parseInclusions "haskell quasi-quote" <$> pure (T.pack txt)-    let context = fmap (traverse (madCtx ".")) (fmap T.unpack <$> inclusions)+    let context = fmap (traverse (madCtxCheck ".")) (fmap T.unpack <$> inclusions)     erroredFiles <- errorgen context     inclusions' <- lift (T.unpack <$> errorgen inclusions)     pure $ VarE 'errorgen `AppE` (parse' `AppE` (VarE 'ctx `AppE` inclusions' `AppE` ListE erroredFiles) `AppE` (VarE 'T.pack `AppE` LitE (StringL txt)))@@ -68,15 +69,15 @@ errorgen :: Either (ParseError Char (ErrorFancy Void)) a -> a errorgen = either (error . T.unpack . show') id -embedFileCheck :: FilePath -> FilePath -> Q Exp-embedFileCheck folder path = do+madCtxCheck :: FilePath -> FilePath -> Q Exp+madCtxCheck folder path = do     let tryPath = folder ++ path     local <- runIO $ doesFileExist tryPath     home <- runIO $ getEnv "HOME"     if local then-        embedStringFile tryPath+        madCtx folder path     else-        embedStringFile (home ++ "/.madlang/" ++ path) -- FIXME windows+        madCtx (home ++ (pathSep : (".madlang" ++ pure pathSep))) path  ctx :: [FilePath] -> [[(Key, RandTok)]] -> [[(Key, RandTok)]] ctx = zipWith resolveKeys@@ -84,11 +85,11 @@  madCtx :: FilePath -> FilePath -> Q Exp madCtx folder path = do-    file <- embedFileCheck folder path-    let tryPath = folder ++ "/" ++ path+    let tryPath = folder ++ path+    file <- embedStringFile tryPath     inclusions <- parseInclusions tryPath <$> runIO (TIO.readFile tryPath)     parse' <- [|parseTokFInternal path []|]-    dependencies <- traverse (madCtx folder) (T.unpack <$> errorgen inclusions)+    dependencies <- traverse (madCtxCheck folder) (T.unpack <$> errorgen inclusions)     inclusions' <- lift (T.unpack <$> errorgen inclusions)     pure $ VarE 'errorgen `AppE` (parse' `AppE` (VarE 'ctx `AppE` inclusions' `AppE` ListE dependencies) `AppE` file) @@ -105,7 +106,7 @@ madFile path = do     inclusions <- parseInclusions path <$> runIO (TIO.readFile path)     file <- embedStringFile path-    let context = fmap (traverse (madCtx (getDir path))) (fmap T.unpack <$> inclusions)+    let context = fmap (traverse (madCtxCheck (getDir path))) (fmap T.unpack <$> inclusions)     erroredFiles <- errorgen context     parse' <- [|parseTokInternal path []|]     inclusions' <- lift (T.unpack <$> errorgen inclusions)

@@ -9,10 +9,7 @@ import           Text.Madlibs  demo :: RandTok-demo = $(madFile "test/templates/include.mad")---- demoDir :: [(Key, RandTok)]--- demoDir = $(madEmbed "test/templates" "gambling.mad")+demo = $(madFile "test/templates/include-recursive.mad")  demoQQ :: RandTok demoQQ = [madlang|

@@ -47,7 +47,7 @@             runFile [] "test/templates/ordered.mad" >>= (`shouldSatisfy` (\a -> elem a ["heads","tails","one","two","three","third","fourth"]))     describe "readFileQ" $         parallel $ it "executes embedded code" $-        runTest >>= (`shouldSatisfy` (\a -> elem a ["heads","tails", "on its side"]))+        runTest >>= (`shouldSatisfy` (\a -> elem a ["HEADS","tails", "on its side"]))     describe "madlang" $         parallel $ it "provides a quasi-quoter" $         runTestQQ >>= (`shouldSatisfy` (\a -> elem a ["hello","goodbye"]))