diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,5 @@ # Madlang DSL for generating random text + [![Build Status](https://travis-ci.org/vmchale/madlibs.svg?branch=master)](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). diff --git a/default.nix b/default.nix --- a/default.nix +++ b/default.nix @@ -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 = [ diff --git a/madlang.cabal b/madlang.cabal --- a/madlang.cabal +++ b/madlang.cabal @@ -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 diff --git a/src/Text/Madlibs/Ana/Parse.hs b/src/Text/Madlibs/Ana/Parse.hs --- a/src/Text/Madlibs/Ana/Parse.hs +++ b/src/Text/Madlibs/Ana/Parse.hs @@ -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] diff --git a/src/Text/Madlibs/Ana/Resolve.hs b/src/Text/Madlibs/Ana/Resolve.hs --- a/src/Text/Madlibs/Ana/Resolve.hs +++ b/src/Text/Madlibs/Ana/Resolve.hs @@ -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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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" diff --git a/test/templates/cat.mad b/test/templates/cat.mad new file mode 100644 --- /dev/null +++ b/test/templates/cat.mad @@ -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