madlang 2.3.2.0 → 2.4.0.0
raw patch · 8 files changed
+91/−46 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +3/−4
- default.nix +9/−8
- madlang.cabal +1/−1
- src/Text/Madlibs/Ana/Parse.hs +40/−20
- src/Text/Madlibs/Ana/Resolve.hs +9/−5
- stack.yaml +3/−0
- test/Spec.hs +11/−8
- test/templates/cat.mad +15/−0
README.md view
@@ -1,4 +1,5 @@ # Madlang DSL for generating random text+ [](https://travis-ci.org/vmchale/madlibs) This is the Madlang DSL for generating text. You specify a template, and Madlang@@ -45,9 +46,6 @@ ### Releases -If you're on windows or linux, grabbing release binaries simplest. -Find them [here](https://github.com/vmchale/madlibs/releases).- ### Nix If you're on linux or mac, you can get up-to-date binaries via nix.@@ -80,7 +78,7 @@ You can do `madlang --help` if you want a couple other options for debugging. -## Using the library+## Using the Haskell library One function you might want to use is `runFile`; it reads a file and generates randomized text: @@ -107,6 +105,7 @@ ``` Haddock documentation of all library functionality is located [here](https://hackage.haskell.org/package/madlang#readme).+ ## Syntax Highlighting Syntax highlighting for the DSL is provided in the vim plugin [here](http://github.com/vmchale/madlang-vim). It includes integration with [syntastic](https://github.com/vim-syntastic/syntastic).
default.nix view
@@ -1,18 +1,19 @@-{ mkDerivation, ansi-wl-pprint, base, composition, containers-, directory, file-embed, hspec, hspec-megaparsec, megaparsec-, microlens, MonadRandom, mtl, optparse-applicative, random-shuffle-, stdenv, template-haskell, text+{ mkDerivation, ansi-wl-pprint, base, composition+, composition-extra, containers, directory, file-embed, hspec+, hspec-megaparsec, megaparsec, microlens, MonadRandom, mtl+, optparse-applicative, random-shuffle, stdenv, template-haskell+, text }: mkDerivation { pname = "madlang";- version = "2.3.1.1";+ version = "2.3.2.0"; src = ./.; isLibrary = true; isExecutable = true; libraryHaskellDepends = [- ansi-wl-pprint base composition containers directory file-embed- megaparsec microlens MonadRandom mtl optparse-applicative- random-shuffle template-haskell text+ ansi-wl-pprint base composition composition-extra containers+ directory file-embed megaparsec microlens MonadRandom mtl+ optparse-applicative random-shuffle template-haskell text ]; executableHaskellDepends = [ base ]; testHaskellDepends = [
madlang.cabal view
@@ -1,5 +1,5 @@ name: madlang-version: 2.3.2.0+version: 2.4.0.0 synopsis: Randomized templating language DSL description: Please see README.md homepage: https://github.com/vmchale/madlang#readme
src/Text/Madlibs/Ana/Parse.hs view
@@ -6,21 +6,21 @@ , parseTreeF , parseTokM ) where -import Text.Madlibs.Internal.Types-import Text.Madlibs.Internal.Utils-import Text.Madlibs.Ana.ParseUtils-import Text.Madlibs.Cata.SemErr-import qualified Data.Text as T-import Text.Megaparsec-import Text.Megaparsec.Text-import qualified Text.Megaparsec.Lexer as L-import Control.Monad-import qualified Data.Map as M-import Control.Monad.State-import Data.Composition-import Data.Maybe+import Control.Monad+import Control.Monad.State+import Data.Composition+import qualified Data.Map as M+import Data.Maybe+import qualified Data.Text as T+import Text.Madlibs.Ana.ParseUtils+import Text.Madlibs.Cata.SemErr+import Text.Madlibs.Internal.Types+import Text.Madlibs.Internal.Utils+import Text.Megaparsec+import qualified Text.Megaparsec.Lexer as L+import Text.Megaparsec.Text --- | Parse a lexeme, aka deal with whitespace nicely. +-- | Parse a lexeme, aka deal with whitespace nicely. lexeme :: Parser a -> Parser a lexeme = L.lexeme spaceConsumer @@ -65,6 +65,11 @@ define = void (nonIndented (keyword "define")) <?> "define block" +-- | Parse the `category` keyword.+cat :: Parser ()+cat = void (nonIndented (keyword "category"))+ <?> "category block"+ -- | Parse the `include` keyword. include :: Parser () include = void (nonIndented (keyword "include"))@@ -88,7 +93,7 @@ -- | Parse template into a `PreTok` of referents and strings preStr :: [T.Text] -> Parser PreTok-preStr ins = do { +preStr ins = do { n <- name ; mod <- many modifier ; spaceConsumer ;@@ -105,7 +110,7 @@ mod <- many modifier ; spaceConsumer ; pure . PreTok . (foldr (.) id mod) . T.pack $ s- } + } <?> "string or function name" -- | Parse a probability/corresponding template@@ -116,6 +121,13 @@ str <- some (preStr ins) pure (p, str) <?> "Probability-text pair" +-- | Parse a function name for a `:category` block.+function :: Parser (Prob, [PreTok])+function = do+ indentGuard+ str <- preStr mempty+ pure (1.0, [str]) <?> "Function name"+ -- | Parse an `include` inclusions :: Parser [String] inclusions = many . try $ do@@ -132,6 +144,14 @@ val <- fmap normalize . some $ pair ins pure (T.pack str, val) <?> "define block" +-- | Parse a `category` block+category :: Parser (Key, [(Prob, [PreTok])])+category = do+ cat+ str <- name+ val <- fmap normalize . some $ function+ pure (T.pack str, val) <?> "category block"+ -- | Parse the `:return` block final :: [T.Text] -> Parser [(Prob, [PreTok])] final ins = do@@ -143,7 +163,7 @@ program :: [T.Text] -> Parser [(Key, [(Prob, [PreTok])])] program ins = sortKeys <$> (checkSemantics =<< do inclusions- p <- many (try (definition ins) <|> ((,) "Return" <$> final ins))+ p <- many (try (definition ins) <|> try category <|> ((,) "Return" <$> final ins)) lexeme eof pure p) @@ -157,12 +177,12 @@ -- | Parse text as a list of functions parseTokF :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char Dec) [(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 Dec) [(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@@ -181,7 +201,7 @@ -- | Parse text as a token, suitable for printing as a tree.. parseTree :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char Dec) RandTok-parseTree = (fmap takeTemplate) .*** parseTreeF +parseTree = (fmap takeTemplate) .*** parseTreeF -- | Parse inclustions parseInclusions :: FilePath -> T.Text -> Either (ParseError Char Dec) [String]
src/Text/Madlibs/Ana/Resolve.hs view
@@ -2,13 +2,13 @@ -- | Module containing IO stuff to get/parse files with external dependencies module Text.Madlibs.Ana.Resolve (- parseFile + parseFile , runFile- , makeTree + , makeTree , runText ) where import qualified Data.Text as T-import Text.Megaparsec+import Text.Megaparsec hiding (try) import Text.Madlibs.Internal.Types import Text.Madlibs.Internal.Utils import Text.Madlibs.Ana.Parse@@ -19,6 +19,8 @@ import Lens.Micro import Data.Monoid import Control.Monad.Random.Class+import System.Environment+import Control.Exception -- | Parse a template file into the `RandTok` data type parseFile :: [T.Text] -- ^ variables to substitute into the template@@ -30,12 +32,14 @@ -- | Generate text from file with inclusions getInclusionCtx :: Bool -> [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char Dec) [(Key, RandTok)]) getInclusionCtx isTree ins folder filepath = do- file <- readFile' (folder ++ filepath)+ file <- catch (readFile' (folder ++ filepath)) (const (do { home <- getEnv "HOME" ; readFile' (home <> "/.madlang/" <> folder <> filepath) } ) :: IOException -> IO T.Text) let filenames = either (error . show) id $ parseInclusions filepath file -- TODO pass up errors correctly let resolveKeys file = map (over _1 ((((T.pack . (<> "-")) . dropExtension) file) <>)) ctxPure <- mapM (getInclusionCtx isTree ins folder) filenames let ctx = (zipWith resolveKeys filenames) <$> sequence ctxPure- parseCtx isTree ins (concat . (either (const []) id) $ ctx) (folder ++ filepath)+ 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 Dec) [(Key, RandTok)])) -- | Generate randomized text from a file containing a template runFile :: [T.Text] -- ^ List of variables to substitute into the template
stack.yaml view
@@ -34,6 +34,9 @@ linux64: 8.2.0.20170507: url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-deb8-linux.tar.xz+ linux64-nopie:+ 8.2.0.20170507:+ url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-deb8-linux.tar.xz macosx: 8.2.0.20170507: url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-apple-darwin.tar.xz
test/Spec.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -import Demo-import Test.Hspec-import Test.Hspec.Megaparsec-import Text.Madlibs-import Data.Function-import qualified Data.Text as T+import Data.Function+import qualified Data.Text as T+import Demo+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.Madlibs main :: IO () main = hspec $ do@@ -22,11 +22,14 @@ parallel $ it "parses when functions are out of order" $ do file <- madComplexFile parseTok "" [] [] `shouldSucceedOn` file+ 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 (run) exampleTok >>= (`shouldSatisfy` (\a -> on (||) (a ==) "heads" "tails")) parallel $ it "throws exception when two `:return`s are declared" $ do file <- semErrFile- (parseTok "" [] [] `shouldFailOn` file) + (parseTok "" [] [] `shouldFailOn` file) parallel $ it "substitutes a variable correctly" $ do file <- madVar parseTok "" [] ["maxine"] `shouldSucceedOn` file@@ -66,7 +69,7 @@ includeFile = readFile' "test/templates/include.mad" madFileBasic :: IO T.Text-madFileBasic = readFile' "test/templates/gambling.mad" +madFileBasic = readFile' "test/templates/gambling.mad" madFileTibetan :: IO T.Text madFileTibetan = readFile' "test/templates/ཤོ.mad"
+ test/templates/cat.mad view
@@ -0,0 +1,15 @@+:category places+ country+ state++:define country+ 1.0 "UK"+ 1.0 "USA"++:define state+ 1.0 "Maryland"+ 1.0 "Rhode Island"+ 1.0 "Delaware"++:return+ 1.0 places