madlang 3.1.1.21 → 3.1.2.0

raw patch · 9 files changed

+48/−17 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cabal.project.local +1/−1
• demo/bi-update.mad +1/−0
• madlang.cabal +1/−1
• src/Text/Madlibs/Ana/Parse.hs +11/−2
• src/Text/Madlibs/Ana/Resolve.hs +1/−0
• src/Text/Madlibs/Generate/TH.hs +30/−11
• src/Text/Madlibs/Internal/Utils.hs +1/−0
• test/Demo.hs +1/−1
• test/Spec.hs +1/−1

@@ -1,3 +1,3 @@-with-compiler: ghc-8.2.1+with-compiler: ghc-8.2.2 optimization: 1 constraints: madlang +development

@@ -1,4 +1,5 @@ # inspired by https://twitter.com/biupdatebot+# install libraries with `madlang install` if necessary. :include adverbs.mad  :return

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

@@ -8,7 +8,9 @@   , parseInclusions   , parseTree   , parseTreeF-  , parseTokM ) where+  , parseTokM+  , parseTokInternal+  ) where  import           Control.Composition import           Control.Monad@@ -220,10 +222,17 @@     -> Either (ParseError Char (ErrorFancy Void)) RandTok -- ^ Result parseTok = fmap takeTemplate .*** parseTokF +parseTokInternal :: FilePath+                 -> [T.Text]+                 -> [[(Key, RandTok)]]+                 -> T.Text+                 -> Either (ParseError Char (ErrorFancy Void)) RandTok+parseTokInternal path ins ctx = parseTok path (join ctx) ins+ -- | Parse text as a token, suitable for printing as a tree.. parseTree :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char (ErrorFancy Void)) RandTok parseTree = fmap takeTemplate .*** parseTreeF --- | Parse inclustions+-- | Parse inclusions parseInclusions :: FilePath -> T.Text -> Either (ParseError Char (ErrorFancy Void)) [T.Text] parseInclusions = runParser inclusions

@@ -7,6 +7,7 @@   , makeTree   , runText   , runFileN+  , pathSep   ) where  import           Control.Arrow               (first)

@@ -10,16 +10,20 @@     , madlang     ) where +import           Control.Arrow               (first) import           Control.Monad.IO.Class      (MonadIO, liftIO)-import           Data.FileEmbed+import           Data.FileEmbed              (embedStringFile)+import           Data.Monoid import qualified Data.Text                   as T-import           Data.Text.Encoding+import qualified Data.Text.IO                as TIO import           Data.Void import           Language.Haskell.TH         hiding (Dec) import           Language.Haskell.TH.Quote---import           Language.Haskell.TH.Syntax  (Lift, lift)+import           Language.Haskell.TH.Syntax  (lift)+import           System.Directory            (doesFileExist)+import           System.Environment          (getEnv) import           Text.Madlibs.Ana.Parse---import           Text.Madlibs.Ana.Resolve+import           Text.Madlibs.Internal.Types (Key, RandTok) import           Text.Madlibs.Internal.Utils import           Text.Megaparsec @@ -59,9 +63,20 @@ errorgen :: Either (ParseError Char (ErrorFancy Void)) a -> a errorgen = either (error . T.unpack . show') id --- embedFancy :: FilePath -> FilePath -> Q Exp--- embedFancy file folder = parseFile [] file folder >>= ((VarE 'errorgen `AppE`) . lift)+embedFileCheck :: FilePath -> FilePath -> Q Exp+embedFileCheck folder path = do+    let tryPath = folder ++ path+    local <- runIO $ doesFileExist tryPath+    home <- runIO $ getEnv "HOME"+    if local then+        embedStringFile tryPath+    else+        embedStringFile (home ++ "/.madlang/" ++ path) -- FIXME windows +ctx :: [FilePath] -> [[(Key, RandTok)]] -> [[(Key, RandTok)]]+ctx = zipWith resolveKeys+    where resolveKeys file = fmap (first (((T.pack . (<> "-")) . dropExtension) file <>))+ -- | Splice for embedding a '.mad' file, e.g. -- -- @@@ -70,10 +85,14 @@ --     $(madFile "twitter-bot.mad") -- @ ----- Note that the embedded code cannot have any inclusions+-- Embedded code can contain inclusions. madFile :: FilePath -> Q Exp madFile path = do-    file <- embedFile path-    -- dependencies <- parse inclusions-    parse' <- [|parseTok "source" [] [] . decodeUtf8|] -- TODO make this recurse but still work!-    pure $ VarE 'errorgen `AppE` (parse' `AppE` file)+    inclusions <- parseInclusions path <$> runIO (TIO.readFile path)+    file <- embedStringFile path+    let files = fmap (traverse (embedFileCheck (getDir path))) (fmap T.unpack <$> inclusions)+    erroredFiles <- errorgen files+    parse' <- [|parseTokInternal path []|]+    parseDependency <- [|(fmap (errorgen . parseTokF "source" [] []))|]+    inclusions' <- lift (fmap T.unpack . errorgen $ inclusions)+    pure $ VarE 'errorgen `AppE` (parse' `AppE` (VarE 'ctx `AppE` inclusions' `AppE` (parseDependency `AppE` ListE erroredFiles)) `AppE` file)

@@ -20,6 +20,7 @@ -- | Get directory associated to a file getDir :: FilePath -> FilePath getDir = reverse . dropWhile (/='/') . reverse+-- FIXME should work on Windows  -- | Function to apply a value on both arguments, e.g. --

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

@@ -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"]))+        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"]))