madlang 3.1.2.0 → 3.2.0.0

raw patch · 3 files changed

+32/−13 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• madlang.cabal +1/−1
• src/Text/Madlibs/Ana/Parse.hs +9/−4
• src/Text/Madlibs/Generate/TH.hs +22/−8

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

@@ -10,6 +10,7 @@   , parseTreeF   , parseTokM   , parseTokInternal+  , parseTokFInternal   ) where  import           Control.Composition@@ -200,14 +201,15 @@  -- | Parse text as a list of functions parseTokF :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]-parseTokF filename state' ins f = flip execState (filterTemplate state') <$> runParser (parseTokM ins) filename f-    where filterTemplate = map (\(i,j) -> if i == "Return" then (strip filename, j) else (i,j)) -- TODO fix the extras+parseTokF filename state' ins f = flip execState (filterTemplate filename state') <$> runParser (parseTokM ins) filename f  -- | Parse text as a list of tokens, suitable for printing as a tree. parseTreeF :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]-parseTreeF filename state' ins f = flip execState (filterTemplate state') <$> runParser (parseTreeM ins) filename f-    where filterTemplate = map (\(i,j) -> if i == "Return" then (strip filename, j) else (i,j))+parseTreeF filename state' ins f = flip execState (filterTemplate filename state') <$> runParser (parseTreeM ins) filename f +filterTemplate :: String -> [(T.Text, t)] -> [(T.Text, t)]+filterTemplate filename = map (\(i,j) -> if i == "Return" then (strip filename, j) else (i,j)) -- TODO fix the extras+ -- | Parse text given a context -- -- > import qualified Data.Text.IO as TIO@@ -228,6 +230,9 @@                  -> T.Text                  -> Either (ParseError Char (ErrorFancy Void)) RandTok parseTokInternal path ins ctx = parseTok path (join ctx) ins++parseTokFInternal :: FilePath -> [T.Text] -> [[(Key, RandTok)]] -> T.Text -> Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]+parseTokFInternal path ins ctx = parseTokF 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

@@ -51,13 +51,18 @@                       , quotePat = error "quasi-quoter does not support patterns"                       , quoteType = error "quasi-quoter does not support types"                       , quoteDec = error "quasi-quoter does not support top-level quotes"-                      } -- TODO add quasiQuoter w/inclusions or context+                      }  -- | Convert a `String` containing  to a `Q Exp` with the parsed syntax tree.+-- Embedded code can contain inclusions. textToExpression :: String -> Q Exp textToExpression txt = do-    parse' <- [|parseTok "source" [] []|]-    pure $ VarE 'errorgen `AppE` (parse' `AppE` (VarE 'T.pack `AppE` LitE (StringL txt)))+    parse' <- [|parseTokInternal "haskell quasi-quote" []|]+    inclusions <- parseInclusions "haskell quasi-quote" <$> pure (T.pack txt)+    let context = fmap (traverse (madCtx ".")) (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)))  -- | 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@@ -77,6 +82,16 @@ ctx = zipWith resolveKeys     where resolveKeys file = fmap (first (((T.pack . (<> "-")) . dropExtension) file <>)) +madCtx :: FilePath -> FilePath -> Q Exp+madCtx folder path = do+    file <- embedFileCheck folder path+    let tryPath = folder ++ "/" ++ path+    inclusions <- parseInclusions tryPath <$> runIO (TIO.readFile tryPath)+    parse' <- [|parseTokFInternal path []|]+    dependencies <- traverse (madCtx 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)+ -- | Splice for embedding a '.mad' file, e.g. -- -- @@@ -90,9 +105,8 @@ madFile path = do     inclusions <- parseInclusions path <$> runIO (TIO.readFile path)     file <- embedStringFile path-    let files = fmap (traverse (embedFileCheck (getDir path))) (fmap T.unpack <$> inclusions)-    erroredFiles <- errorgen files+    let context = fmap (traverse (madCtx (getDir path))) (fmap T.unpack <$> inclusions)+    erroredFiles <- errorgen context     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)+    inclusions' <- lift (T.unpack <$> errorgen inclusions)+    pure $ VarE 'errorgen `AppE` (parse' `AppE` (VarE 'ctx `AppE` inclusions' `AppE` ListE erroredFiles) `AppE` file)