madlang 2.0.1.2 → 2.1.0.0

raw patch · 11 files changed

+129/−121 lines, 11 filesdep +compositiondep +directorydep ~madlang

Dependencies added: composition, directory

Dependency ranges changed: madlang

Files

• README.md +12/−0
• madlang.cabal +10/−6
• src/Text/Madlibs.hs +3/−2
• src/Text/Madlibs/Ana/Parse.hs +27/−12
• src/Text/Madlibs/Ana/ParseUtils.hs +5/−1
• src/Text/Madlibs/Ana/Resolve.hs +38/−0
• src/Text/Madlibs/Exec/Main.hs +10/−29
• src/Text/Madlibs/Internal/Utils.hs +9/−0
• stack.yaml +0/−62
• test/Spec.hs +9/−9
• test/templates/include.mad +6/−0

@@ -49,6 +49,18 @@ If you're on windows or linux, grabbing release binaries is probably the easiest. Find them [here](https://github.com/vmchale/madlibs/releases). +### Nix++If you're on linux or mac, you can just grab the binaries via nix.++Download nix with++```+curl https://nixos.org/nix/install | sh+```++From there, `nix-env -i madlang` will install the proper executables.+ ### Stack  Download `stack` with

@@ -1,5 +1,5 @@ name: madlang-version: 2.0.1.2+version: 2.1.0.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -18,6 +18,7 @@     test/templates/fortune-teller.mad     test/templates/gambling.mad     test/templates/var.mad+    test/templates/include.mad     test/templates/err/*.mad     bench/templates/*.mad     stack.yaml@@ -40,12 +41,14 @@         megaparsec >=5.2.0 && <5.3,         text >=1.2.2.1 && <1.3,         optparse-applicative >=0.13.2.0 && <0.14,+        composition >=1.0.2.1 && <1.1,+        directory >=1.3.0.0 && <1.4,         mwc-random >=0.13.5.0 && <0.14,-        lens >=4.15.1 && <4.16,         mtl >=2.2.1 && <2.3,         ansi-wl-pprint >=0.6.7.3 && <0.7,         containers >=0.5.7.1 && <0.6,-        tibetan-utils >=0.1.1.2 && <0.2+        tibetan-utils >=0.1.1.2 && <0.2,+        lens >=4.15.1 && <4.16     default-language: Haskell2010     default-extensions: OverloadedStrings DeriveGeneric DeriveFunctor                         DeriveAnyClass@@ -54,6 +57,7 @@         Text.Madlibs.Ana.ParseUtils         Text.Madlibs.Cata.Run         Text.Madlibs.Ana.Parse+        Text.Madlibs.Ana.Resolve         Text.Madlibs.Internal.Types         Text.Madlibs.Internal.Utils         Text.Madlibs.Cata.SemErr@@ -68,7 +72,7 @@     main-is: Main.hs     build-depends:         base >=4.9.1.0 && <4.10,-        madlang >=2.0.1.2 && <2.1+        madlang >=2.1.0.0 && <2.2     default-language: Haskell2010     hs-source-dirs: app @@ -77,7 +81,7 @@     main-is: Spec.hs     build-depends:         base >=4.9.1.0 && <4.10,-        madlang >=2.0.1.2 && <2.1,+        madlang >=2.1.0.0 && <2.2,         hspec >=2.4.2 && <2.5,         megaparsec >=5.2.0 && <5.3,         text >=1.2.2.1 && <1.3,@@ -98,7 +102,7 @@     build-depends:         base >=4.9.1.0 && <4.10,         criterion >=1.1.4.0 && <1.2,-        madlang >=2.0.1.2 && <2.1,+        madlang >=2.1.0.0 && <2.2,         megaparsec >=5.2.0 && <5.3,         text >=1.2.2.1 && <1.3     default-language: Haskell2010

@@ -5,17 +5,18 @@                     , parseTokM                     , runFile                     , parseFile-                    , templateGen+                    , makeTree                     -- * Functions and constructs for the `RandTok` data type                     , run                     , RandTok (..)                     -- * Types associated with the parser                     , Context                     , SemanticError (..)-                    -- * Command-line runMadlangutable+                    -- * Command-line executable                     , runMadlang                     ) where +import Text.Madlibs.Ana.Resolve import Text.Madlibs.Ana.Parse import Text.Madlibs.Ana.ParseUtils import Text.Madlibs.Cata.Run

@@ -15,6 +15,7 @@ import Control.Monad.State import Text.Megaparsec.Lexer.Tibetan import Control.Exception hiding (try)+import Data.Composition  -- | Parse a lexeme, aka deal with whitespace nicely.  lexeme :: Parser a -> Parser a@@ -61,8 +62,9 @@ define = void (nonIndented (keyword "define"))     <?> "define block" +-- | Parse the `include` keyword. include :: Parser ()-include = void (nonIndented (keyword "define"))+include = void (nonIndented (keyword "include"))     <?> "include"  -- | Parse the `:return` keyword.@@ -72,7 +74,7 @@  -- | Parse a template name (what follows a `:define` or `return` block) name :: Parser String-name = lexeme (some letterChar) <?> "template name"+name = lexeme (some (letterChar <|> oneOf ("-/" :: String))) <?> "template name"  -- | Parse template into a `PreTok` of referents and strings preStr :: [T.Text] -> Parser PreTok@@ -97,16 +99,13 @@     pure (p, str) <?> "Probability/text pair"  -- | Parse an `include`--- TODO define semantics for variables and all that? inclusions :: Parser [String]-inclusions = many $ do+inclusions = many . try $ do     include     str <- name     string ".mad"     pure (str ++ ".mad")-        -- TODO verify that libraries don't return a value?-        -- or define semantics there. idk how namespaces/all that will work-        -- current thought: parse inclusions once, resolve dependencies etc. there. +        -- still needs dependency resolution but eh  -- | Parse a `define` block definition :: [T.Text] -> Parser (Key, [(Prob, [PreTok])])@@ -126,7 +125,8 @@ -- | Parse the program in terms of `PreTok` and the `Key`s to link them. program :: [T.Text] -> Parser [(Key, [(Prob, [PreTok])])] program ins = sortKeys <$> (checkSemantics =<< do-    p <- many (try (definition ins) <|> ((,) "Template" <$> final ins)) -- FIXME: parse multiple `returns`? why isn't indentation working @ all?+    inclusions+    p <- many (try (definition ins) <|> ((,) "Template" <$> final ins))     lexeme eof     pure p) @@ -138,13 +138,28 @@ parseTreeM :: [T.Text] -> Parser (Context RandTok) parseTreeM ins = buildTree <$> program ins +-- | 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 +    where filterTemplate = map (\(i,j) -> if i == "Template" then (T.pack filename, j) else (i,j)) -- problem: doesn't tell what file we're reading FROM++-- | 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 +    where filterTemplate = map (\(i,j) -> if i == "Template" then (T.pack filename, j) else (i,j))+ -- | Parse text as a token -- -- > f <- readFile "template.mad" -- > parseTok f-parseTok :: FilePath -> [T.Text] -> T.Text -> Either (ParseError Char Dec) RandTok-parseTok filename ins f = snd . head . (filter (\(i,j) -> i == "Template")) . (flip execState []) <$> runParser (parseTokM ins) filename f+-- | Parse text given a context+parseTok :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char Dec) RandTok+parseTok = (fmap takeTemplate) .*** parseTokF  -- | Parse text as a token, suitable for printing as a tree..-parseTree :: FilePath -> [T.Text] -> T.Text -> Either (ParseError Char Dec) RandTok-parseTree filename ins f = snd . head . (filter (\(i,j) -> i == "Template")) . (flip execState []) <$> runParser (parseTreeM ins) filename f+parseTree :: FilePath -> [(Key, RandTok)] -> [T.Text] -> T.Text -> Either (ParseError Char Dec) RandTok+parseTree = (fmap takeTemplate) .*** parseTreeF ++-- | Parse inclustions+parseInclusions :: FilePath -> T.Text -> Either (ParseError Char Dec) [String]+parseInclusions = runParser inclusions

@@ -13,12 +13,16 @@  --TODO consider moving Ana.ParseUtils to Cata.Sorting +-- | Get the :return value+takeTemplate :: [(Key, RandTok)] -> RandTok+takeTemplate = snd . head . filter (\(i,j) -> i == "Template")+ -- | Convert the stuff after the number to a `RandTok` concatTok :: T.Text -> Context [PreTok] -> Context RandTok concatTok param pretoks = do     ctx <- get     let unList (List a) = a-    let toRand (Name str) = List . snd . (head' str param) . (filter ((== str) . fst)) . (map (second unList)) $ ctx -- TODO move the shared functions to utils+    let toRand (Name str) = List . snd . (head' str param) . (filter ((== str) . fst)) . (map (second unList)) $ ctx-- TODO fix head' which can fail because of lack of scope too         toRand (PreTok txt) = Value txt     fold . (map toRand) <$> pretoks 

@@ -0,0 +1,38 @@+-- | Module containing IO stuff to get/parse files with external dependencies+module Text.Madlibs.Ana.Resolve where++import qualified Data.Text as T+import Text.Megaparsec+import Text.Madlibs.Internal.Types+import Text.Madlibs.Internal.Utils+import Text.Madlibs.Ana.Parse+import Text.Madlibs.Ana.ParseUtils+import Text.Madlibs.Cata.Run+import Data.Composition++-- | Parse a template file into the `RandTok` data type+parseFile :: [T.Text] -> FilePath -> IO (Either (ParseError Char Dec) RandTok)+parseFile = fmap (fmap takeTemplate) .* (getInclusionCtx False)++-- | Generate text from file with inclusions+getInclusionCtx :: Bool -> [T.Text] -> FilePath -> IO (Either (ParseError Char Dec) [(Key, RandTok)])+getInclusionCtx isTree ins filepath = do+    file <- readFile' filepath+    let filenames = either (const []) id $ parseInclusions filepath file -- FIXME pass up errors correctly+    ctx <- mapM (getInclusionCtx isTree ins) filenames +    parseCtx isTree ins (concatMap (either (const []) id) ctx) filepath++-- | Generate randomized text from a file conatining a template+runFile :: [T.Text] -> FilePath -> IO T.Text+runFile = ((either (pure . parseErrorPretty') (>>= (pure . show'))) =<<) .* (fmap (fmap run) .* parseFile)++-- | Get file as context+parseCtx :: Bool -> [T.Text] -> [(Key, RandTok)] -> FilePath -> IO (Either (ParseError Char Dec) [(Key, RandTok)]) +parseCtx isTree ins state filepath = do+    txt <- readFile' filepath+    let keys = (if isTree then parseTreeF else parseTokF) filepath state ins txt+    pure keys++-- | Parse a template into a RandTok suitable to be displayed as a tree+makeTree :: [T.Text] -> FilePath -> IO (Either (ParseError Char Dec) RandTok)+makeTree = fmap (fmap takeTemplate) .* (getInclusionCtx True)

@@ -3,7 +3,7 @@  import Control.Monad import Text.Madlibs.Cata.Run-import Text.Madlibs.Ana.Parse+import Text.Madlibs.Ana.Resolve import Text.Madlibs.Internal.Types import Text.Madlibs.Internal.Utils import qualified Data.Text as T@@ -11,8 +11,10 @@ import Text.Megaparsec import Options.Applicative hiding (ParseError) import Data.Monoid+import Data.Composition+import System.Directory ---import Data.Tree+import Text.Madlibs.Ana.Parse  -- | datatype for the program data Program = Program { sub :: Subcommand @@ -53,8 +55,9 @@         <> help "Number of times to repeat"))     <*> (many $ strOption         (short 'i'-        <> metavar "VAR"+        <>  metavar "VAR"         <> help "command-line inputs to the template."))+        -- TODO consider making arguments nicer?  -- | Parser for the lint subcommand lint :: Parser Subcommand@@ -77,38 +80,16 @@ -- | given a parsed record perform the appropriate IO action template :: Program -> IO () template rec = do-    let filepath = input $ rec+    let toFolder = input rec+    if getDir toFolder == "" then pure () else setCurrentDirectory (getDir toFolder)+    let filepath = reverse . (takeWhile (/='/')) . reverse $ toFolder     let ins = map T.pack $ (clInputs . sub $ rec)     case sub rec of         (Run reps _) -> do             parsed <- parseFile ins filepath             replicateM_ (maybe 1 id reps) $ runFile ins filepath >>= TIO.putStrLn          (Debug _) -> do-            putStr . (either show (drawTree . tokToTree 1.0)) =<< makeTree ins filepath -- parsed+            putStr . (either show displayTree) =<< makeTree ins filepath          (Lint _) -> do             parsed <- parseFile ins filepath             putStrLn $ either parseErrorPretty (const "No syntax errors found.") parsed---- | Generate randomized text from a template-templateGen :: FilePath -> [T.Text] -> T.Text -> Either (ParseError Char Dec) (IO T.Text)-templateGen filename ins txt = run <$> parseTok filename ins txt---- | Generate randomized text from a file conatining a template-runFile :: [T.Text] -> FilePath -> IO T.Text-runFile ins filepath = do-    txt <- readFile' filepath-    either (pure . parseErrorPretty') (>>= (pure . show')) (templateGen filepath ins txt)---- | Parse a template file into the `RandTok` data type-parseFile :: [T.Text] -> FilePath -> IO (Either (ParseError Char Dec) RandTok)-parseFile ins filepath = do-    txt <- readFile' filepath-    let val = parseTok filepath ins txt-    pure val---- | Parse a template into a RandTok suitable to be displayed as a tree-makeTree :: [T.Text] -> FilePath -> IO (Either (ParseError Char Dec) RandTok)-makeTree ins filepath = do-    txt <- readFile' filepath-    let val = parseTree filepath ins txt-    pure val

@@ -10,6 +10,15 @@ import qualified Data.Text as T import System.IO.Unsafe import Control.Lens+import Data.Tree++-- | Draw as a syntax Tree+displayTree :: RandTok -> String+displayTree = drawTree . tokToTree 1.0++-- | Get directory associated to a file+getDir :: FilePath -> FilePath+getDir = reverse . (dropWhile (/='/')) . reverse  -- | Function to apply a value on both arguments, e.g. --

@@ -1,69 +1,7 @@-# This file was automatically generated by 'stack init'-#-# Some commonly used options have been documented as comments in this file.-# For advanced use and comprehensive documentation of the format, please see:-# http://docs.haskellstack.org/en/stable/yaml_configuration/--# A warning or info to be displayed to the user on config load.--# Resolver to choose a 'specific' stackage snapshot or a compiler version.-# A snapshot resolver dictates the compiler version and the set of packages-# to be used for project dependencies. For example:-#-# resolver: lts-3.5-# resolver: nightly-2015-09-21-# resolver: ghc-7.10.2-# resolver: ghcjs-0.1.0_ghc-7.10.2-# resolver:-#  name: custom-snapshot-#  location: "./custom-snapshot.yaml" resolver: lts-8.5--# User packages to be built.-# Various formats can be used as shown in the example below.-#-# packages:-# - some-directory-# - https://example.com/foo/bar/baz-0.0.2.tar.gz-# - location:-#    git: https://github.com/commercialhaskell/stack.git-#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a-# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a-#   extra-dep: true-#  subdirs:-#  - auto-update-#  - wai-#-# A package marked 'extra-dep: true' will only be built if demanded by a-# non-dependency (i.e. a user package), and its test suites and benchmarks-# will not be run. This is useful for tweaking upstream packages. packages: - '.'-# Dependency packages to be pulled from upstream that are not in the resolver-# (e.g., acme-missiles-0.3) extra-deps: - tibetan-utils-0.1.1.2--# Override default flag values for local packages and extra-deps flags: {}--# Extra package databases containing global packages extra-package-dbs: []--# Control whether we use the GHC we find on the path-# system-ghc: true-#-# Require a specific version of stack, using version ranges-# require-stack-version: -any # Default-# require-stack-version: ">=1.4"-#-# Override the architecture used by stack, especially useful on Windows-# arch: i386-# arch: x86_64-#-# Extra directories used by stack for building-# extra-include-dirs: [/path/to/dir]-# extra-lib-dirs: [/path/to/dir]-#-# Allow a newer minor version of GHC than the snapshot specifies-# compiler-check: newer-minor

@@ -17,27 +17,27 @@     describe "parseTok" $ do         parallel $ it "parses a .mad string" $ do             file <- madFile-            parseTok "" [] file `shouldParse` (List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])])-        --parallel $ it "parses tibetan numerals" $ do-        --    file <- madFileTibetan-        --    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+            parseTok "" [] [] `shouldFailOn` file         parallel $ it "parses when functions are out of order" $ do             file <- madComplexFile-            parseTok "" [] `shouldSucceedOn` file+            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+            parseTok "" [] ["maxine"] `shouldSucceedOn` file         parallel $ it "fails when variables are not passed in" $ do             file <- madVar-            (parseTok "" [] `shouldFailOn` file) `shouldThrow` anyException+            (parseTok "" [] [] `shouldFailOn` file) `shouldThrow` anyException+        --parallel $ it "parses tibetan numerals" $ do+        --    file <- madFileTibetan+        --    parseTok "" [] file `shouldParse` (List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])])  semErr :: Selector SemanticError semErr = const True

@@ -0,0 +1,6 @@+:include gambling.mad+:define realistic+    1.0 something+    0.03 "on its side"+:return+    1.0 realistic