packages feed

madlang 2.4.2.22 → 2.4.2.25

raw patch · 7 files changed

+42/−42 lines, 7 files

Files

madlang.cabal view
@@ -1,5 +1,5 @@ name:                madlang-version:             2.4.2.22+version:             2.4.2.25 synopsis:            Randomized templating language DSL description:         Madlang is a text templating language written in Haskell,                      meant to explore computational creativity and generative
src/Text/Madlibs/Ana/Parse.hs view
@@ -96,7 +96,7 @@ modifier :: Parser (T.Text -> T.Text) modifier = do     char '.'-    str <- foldr (<|>) (pure "") $ map (try . string) ["to_upper", "to_lower", "reverse", "reverse_words", "oulipo", "capitalize"]+    str <- foldr ((<|>) . try . string) (pure "") ["to_upper", "to_lower", "reverse", "reverse_words", "oulipo", "capitalize"]     pure (fromMaybe id (M.lookup (T.unpack str) modifierList)) <?> "modifier"  -- | Parse template into a `PreTok` of referents and strings@@ -185,12 +185,12 @@  -- | 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+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  -- | 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+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))  -- | Parse text given a context@@ -205,11 +205,11 @@     -> [T.Text] -- ^ list of variables to substitute into the template     -> T.Text -- ^ Actaul text to parse     -> Either (ParseError Char (ErrorFancy Void)) RandTok -- ^ Result-parseTok = (fmap takeTemplate) .*** parseTokF+parseTok = fmap takeTemplate .*** parseTokF  -- | 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+parseTree = fmap takeTemplate .*** parseTreeF  -- | Parse inclustions parseInclusions :: FilePath -> T.Text -> Either (ParseError Char (ErrorFancy Void)) [T.Text]
src/Text/Madlibs/Ana/Resolve.hs view
@@ -30,7 +30,7 @@     -> FilePath -- ^ folder     -> FilePath -- ^ filepath within folder     -> IO (Either (ParseError Char (ErrorFancy Void)) RandTok) -- ^ parsed `RandTok`-parseFile = fmap (fmap takeTemplate) .** (getInclusionCtx False)+parseFile = fmap (fmap takeTemplate) .** getInclusionCtx False  -- | Generate text from file with inclusions getInclusionCtx :: Bool -> [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)])@@ -38,12 +38,12 @@     libDir <- do { home <- getEnv "HOME" ; if os /= home then pure (home <> "/.madlang/") else pure (home <> "\\.madlang\\") }     file <- catch (readFile' (folder ++ filepath)) (const (readFile' (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') <>))+    let resolveKeys file' = fmap (first (((T.pack . (<> "-")) . dropExtension) file' <>))     ctxPure <- mapM (getInclusionCtx isTree ins folder) filenames-    let ctx = (zipWith resolveKeys filenames) <$> sequence ctxPure+    let ctx = zipWith resolveKeys filenames <$> sequence ctxPure     catch-        (parseCtx isTree ins (concat . (either (const []) id) $ ctx) (folder ++ filepath))-        ((const (do { home <- getEnv "HOME" ; parseCtx isTree ins (concat . (either (const []) id) $ ctx) (home <> "/.madlang/" <> folder <> filepath) }) ) :: IOException -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]))+        (parseCtx isTree ins (concat . either (const []) id $ ctx) (folder ++ filepath))+        (const (do { home <- getEnv "HOME" ; parseCtx isTree ins (concat . either (const []) id $ ctx) (home <> "/.madlang/" <> folder <> filepath) }) :: IOException -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]))  -- | Generate randomized text from a file containing a template runFile :: [T.Text] -- ^ List of variables to substitute into the template@@ -51,16 +51,16 @@     -> IO T.Text -- ^ Result runFile ins toFolder = do     void $ doesDirectoryExist (getDir toFolder)-    let filepath = reverse . (takeWhile (/='/')) . reverse $ toFolder+    let filepath = reverse . takeWhile (/='/') . reverse $ toFolder     runInFolder ins (getDir toFolder) filepath  -- | Run in the appropriate folder runInFolder :: [T.Text] -> FilePath -> FilePath -> IO T.Text-runInFolder = ((either (pure . parseErrorPretty') (>>= (pure . show'))) =<<) .** (fmap (fmap run) .** parseFile)+runInFolder = (either (pure . parseErrorPretty') (>>= (pure . show')) =<<) .** (fmap (fmap run) .** parseFile)  -- | Run based on text input, with nothing linked. runText :: (MonadRandom m) => [T.Text] -> String -> T.Text -> m T.Text-runText vars name = (either (pure . parseErrorPretty') id) . (fmap run) . (parseTok name [] vars)+runText vars name = either (pure . parseErrorPretty') id . fmap run . parseTok name [] vars  -- | Get file as context parseCtx :: Bool -> [T.Text] -> [(Key, RandTok)] -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)])@@ -71,4 +71,4 @@  -- | Parse a template into a RandTok suitable to be displayed as a tree makeTree :: [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) RandTok)-makeTree = fmap (fmap takeTemplate) .** (getInclusionCtx True)+makeTree = fmap (fmap takeTemplate) .** getInclusionCtx True
src/Text/Madlibs/Exec/Helpers.hs view
@@ -42,5 +42,5 @@     Tar.unpack packageDir . Tar.read . decompress $ byteStringResponse  cleanPackages :: IO ()-cleanPackages = do+cleanPackages =     putStrLn "done."
src/Text/Madlibs/Generate/TH.hs view
@@ -42,7 +42,7 @@ textToExpression :: String -> Q Exp textToExpression txt = do     parse' <- [|parseTok "source" [] []|]-    pure $ (VarE 'errorgen) `AppE` (parse' `AppE` ((VarE 'T.pack) `AppE` (LitE (StringL (txt)))))+    pure $ VarE 'errorgen `AppE` (parse' `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@@ -59,6 +59,6 @@ -- Note that the embedded code cannot have any inclusions. madFile :: FilePath -> Q Exp madFile path = do-    file <- (embedFile path)-    parse' <- [|(parseTok "source" [] []) . decodeUtf8|] -- TODO make this recurse but still work!-    pure $ (VarE 'errorgen) `AppE` (parse' `AppE` file)+    file <- embedFile path+    parse' <- [|parseTok "source" [] [] . decodeUtf8|] -- TODO make this recurse but still work!+    pure $ VarE 'errorgen `AppE` (parse' `AppE` file)
src/Text/Madlibs/Internal/Utils.hs view
@@ -13,11 +13,11 @@  -- | Drop file Extension dropExtension :: FilePath -> FilePath-dropExtension = reverse . drop 1 . (dropWhile (/='.')) . reverse+dropExtension = reverse . drop 1 . dropWhile (/='.') . reverse  -- | Get directory associated to a file getDir :: FilePath -> FilePath-getDir = reverse . (dropWhile (/='/')) . reverse+getDir = reverse . dropWhile (/='/') . reverse  -- | Function to apply a value on both arguments, e.g. --@@ -38,11 +38,11 @@  -- | Helper function for creating a cdf from a pdf cdf :: [Prob] -> [Prob]-cdf = (drop 2) . (scanl (+) 0) . ((:) 0)+cdf = drop 2 . scanl (+) 0 . (:) 0  -- | Show as a T.Text show' :: (Show a) => a -> T.Text-show' = (T.drop 1) . T.init . T.pack . show+show' = T.drop 1 . T.init . T.pack . show  -- | Pretty-print a ParseError parseErrorPretty' :: ParseError Char (ErrorFancy Void) -> T.Text@@ -55,4 +55,4 @@  -- | Read a file in as a `Text` readFile' :: FilePath -> IO T.Text-readFile' = (fmap T.pack) . readFile+readFile' = fmap T.pack . readFile
test/Spec.hs view
@@ -12,7 +12,7 @@     describe "parseTok" $ do         parallel $ it "parses a .mad string with modifiers" $ do             file <- madFileBasic-            parseTok "" [] [] file `shouldParse` (List [(1.0,List [(0.5,Value "HEADS"),(0.5,Value "tails")])])+            parseTok "" [] [] file `shouldParse` List [(1.0,List [(0.5,Value "HEADS"),(0.5,Value "tails")])]         parallel $ it "fails when quotes aren't closed" $ do             file <- madFileFailure             parseTok "" [] [] `shouldFailOn` file@@ -25,7 +25,7 @@         parallel $ it "parses a function with defined categories" $ do             file <- readFile' "test/templates/cat.mad"             parseTok "" [] [] `shouldSucceedOn` file-        parallel $ it "returns a correct string from the template when evaluating a token" $ do+        parallel $ it "returns a correct string from the template when evaluating a token" $             run exampleTok >>= (`shouldSatisfy` (\a -> on (||) (a ==) "heads" "tails"))         parallel $ it "throws exception when two `:return`s are declared" $ do             file <- semErrFile@@ -37,24 +37,24 @@             file <- madVar             parseTok "" [] [] `shouldFailOn` file `shouldThrow` anyException     describe "runFile" $ do-        parallel $ it "parses nested modifiers and modifiers on variables correctly" $ \_ -> do-            runFile ["aa"] "test/templates/modifiers.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["AAAaaa","AAAaa","AAaaa","AAaa"]))-        parallel $ it "parses file with inclusions and modifiers on functions" $ \_ -> do-            runFile [] "test/templates/include.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["heads","tails","on its side"]))-        parallel $ it "parses file with recursive inclusions" $ \_ -> do-            runFile [] "test/templates/include-recursive.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["HEADS","tails","on its side"]))-        parallel $ it "runs on a file out of order" $ \_ -> do-            runFile [] "test/templates/ordered.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["heads","tails","one","two","three","third","fourth"]))-    describe "readFileQ" $ do-        parallel $ it "executes embedded code" $ do-            runTest >>= (`shouldSatisfy` (\a -> any (a==) ["HEADS","tails"]))-    describe "madlang" $ do-        parallel $ it "provides a quasi-quoter" $ do-            runTestQQ >>= (`shouldSatisfy` (\a -> any (a==) ["hello","goodbye"]))+        parallel $ it "parses nested modifiers and modifiers on variables correctly" $ \_ ->+            runFile ["aa"] "test/templates/modifiers.mad" >>= (`shouldSatisfy` (\a -> elem a ["AAAaaa","AAAaa","AAaaa","AAaa"]))+        parallel $ it "parses file with inclusions and modifiers on functions" $ \_ ->+            runFile [] "test/templates/include.mad" >>= (`shouldSatisfy` (\a -> elem a ["heads","tails","on its side"]))+        parallel $ it "parses file with recursive inclusions" $ \_ ->+            runFile [] "test/templates/include-recursive.mad" >>= (`shouldSatisfy` (\a -> elem a ["HEADS","tails","on its side"]))+        parallel $ it "runs on a file out of order" $ \_ ->+            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"]))+    describe "madlang" $+        parallel $ it "provides a quasi-quoter" $+        runTestQQ >>= (`shouldSatisfy` (\a -> elem a ["hello","goodbye"]))  -- | Read a file in as a `Text` readFile' :: FilePath -> IO T.Text-readFile' = (fmap T.pack) . readFile+readFile' = fmap T.pack . readFile  exampleTok :: RandTok exampleTok = List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])]