diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -57,7 +57,10 @@ curl -sSL http://haskellstack.org | sh ``` -Then run `stack install madlang` and you'll get the `madlang` executable installed on your path. +Then run `stack install madlang --resolver nightly` and you'll get the `madlang` executable installed on your path. + +You can also run `stack install` in the appropriate directory after cloning this +repository. ### Use diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,16 @@ +module Main where + +import Criterion.Main +import Text.Megaparsec +import Text.Madlibs +import qualified Data.Text.IO as TIO + +fun = parse (parseTokM []) "" + +main = do + file <- TIO.readFile "test/templates/fortune-teller.mad" + file2 <- TIO.readFile "bench/templates/magical-realism.mad" + defaultMain [ bgroup "parseFile" + [ bench "fortune-teller" $ whnf fun file + , bench "magical-realism" $ whnf fun file2 ] + ] diff --git a/bench/templates/magical-realism.mad b/bench/templates/magical-realism.mad new file mode 100644 --- /dev/null +++ b/bench/templates/magical-realism.mad @@ -0,0 +1,38 @@ +:define nationality + 1.0 "Hungarian" + 1.0 "Japanese" + 1.0 "Bhutanese" + 1.0 "Spainish" + 1.0 "American" + +:define location + 1.0 "the Basque country" + 1.0 "a Bön monastery" + 1.0 "America" + 1.0 "Saint Petersburg" + 0.5 "the old country" + +:define subject + 1.0 "A princess " + 1.0 "A frog " + 1.0 "A " nationality " professor " + +:define gnomic + 1.0 "That is all." + 1.0 "And so it was written." + 1.0 "The day went on forever." + +:define predicate + 1.0 "invents " object + 3.0 "discovers " object + 1.0 "sleeps" + +:define object + 1.0 "memories" + 1.0 "a ziggurat" + 1.0 "the global financial system" + +:return + 3.0 subject predicate " in " location "." + 5.0 subject predicate "." + 1.0 subject predicate ". " gnomic diff --git a/madlang.cabal b/madlang.cabal --- a/madlang.cabal +++ b/madlang.cabal @@ -1,87 +1,97 @@ -name: madlang -version: 2.0.1.0 -cabal-version: >=1.10 -build-type: Simple -license: BSD3 -license-file: LICENSE -copyright: Copyright: (c) 2016 Vanessa McHale -maintainer: tmchale@wisc.edu -stability: experimental -homepage: https://github.com/vmchale/madlang#readme -synopsis: Randomized templating language DSL -description: - Please see README.md -category: Web -author: Vanessa McHale -extra-source-files: - README.md - test/templates/fortune-teller.mad - test/templates/gambling.mad - test/templates/var.mad - test/templates/err/*.mad - stack.yaml - bash/mkCompletions - -source-repository head - type: git - location: https://github.com/vmchale/madlang +name: madlang +version: 2.0.1.1 +synopsis: Randomized templating language DSL +description: Please see README.md +homepage: https://github.com/vmchale/madlang#readme +license: BSD3 +license-file: LICENSE +author: Vanessa McHale +maintainer: tmchale@wisc.edu +copyright: Copyright: (c) 2016 Vanessa McHale +category: Web +build-type: Simple +stability: experimental +extra-source-files: README.md + , test/templates/fortune-teller.mad + , test/templates/gambling.mad + , test/templates/var.mad + , test/templates/err/*.mad + , bench/templates/*.mad + , stack.yaml + , bash/mkCompletions +cabal-version: >=1.10 -flag llvm-fast - description: - Enable build with llvm backend - default: False +Flag llvm-fast { + Description: Enable build with llvm backend + Default: False +} library - exposed-modules: - Text.Madlibs - build-depends: - base >=4.7 && <5, - megaparsec >=5.2.0 && <5.3, - text >=1.2.2.1 && <1.3, - optparse-applicative >=0.13.2.0 && <0.14, - 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 - default-language: Haskell2010 - default-extensions: OverloadedStrings DeriveGeneric DeriveFunctor - DeriveAnyClass - hs-source-dirs: src - other-modules: - Text.Madlibs.Ana.ParseUtils - Text.Madlibs.Cata.Run - Text.Madlibs.Ana.Parse - Text.Madlibs.Internal.Types - Text.Madlibs.Internal.Utils - Text.Madlibs.Cata.SemErr - Text.Madlibs.Exec.Main + hs-source-dirs: src + exposed-modules: Text.Madlibs + other-modules: Text.Madlibs.Ana.ParseUtils + , Text.Madlibs.Cata.Run + , Text.Madlibs.Ana.Parse + , Text.Madlibs.Internal.Types + , Text.Madlibs.Internal.Utils + , Text.Madlibs.Cata.SemErr + , Text.Madlibs.Exec.Main + build-depends: base >= 4.7 && < 5 + , megaparsec + , text + , optparse-applicative + , mwc-random + , lens + , mtl + , ansi-wl-pprint + , containers + , tibetan-utils + default-language: Haskell2010 + default-extensions: OverloadedStrings + , DeriveGeneric + , DeriveFunctor + , DeriveAnyClass executable madlang - - if flag(llvm-fast) - ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3 - else - ghc-options: -threaded -rtsopts -with-rtsopts=-N - main-is: Main.hs - build-depends: - base >=4.9.1.0 && <4.10, - madlang >=2.0.1.0 && <2.1 - default-language: Haskell2010 - hs-source-dirs: app + hs-source-dirs: app + main-is: Main.hs + if flag(llvm-fast) + ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3 + else + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , madlang + default-language: Haskell2010 +benchmark tweeths-bench + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Bench.hs + build-depends: base + , criterion + , madlang + , megaparsec + , text + if flag(llvm-fast) + ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3 + else + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O3 + default-language: Haskell2010 + test-suite madlang-test - type: exitcode-stdio-1.0 - main-is: Spec.hs - build-depends: - base >=4.9.1.0 && <4.10, - madlang >=2.0.1.0 && <2.1, - hspec >=2.4.2 && <2.5, - megaparsec >=5.2.0 && <5.3, - text >=1.2.2.1 && <1.3, - mtl >=2.2.1 && <2.3, - hspec-megaparsec >=0.3.1 && <0.4 - default-language: Haskell2010 - hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , madlang + , hspec + , megaparsec + , text + , mtl + , hspec-megaparsec + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/vmchale/madlang diff --git a/src/Text/Madlibs.hs b/src/Text/Madlibs.hs --- a/src/Text/Madlibs.hs +++ b/src/Text/Madlibs.hs @@ -1,7 +1,8 @@ -- | Main module exporting the relevant functions module Text.Madlibs ( -- * Parsers for `.mad` files - parseTok + parseTok + , parseTokM , runFile , parseFile , templateGen 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 @@ -44,7 +44,7 @@ -- | Parse between quotes quote :: Parser a -> Parser a -quote = between (char '"') (char '"') -- .$ (char '"') --also CAN'T have any \n AFTER +quote = between (char '"') (char '"') -- | Parse a keyword keyword :: String -> Parser String @@ -61,6 +61,10 @@ define = void (nonIndented (keyword "define")) "define block" +include :: Parser () +include = void (nonIndented (keyword "define")) + "include" + -- | Parse the `:return` keyword. main :: Parser () main = void (nonIndented (keyword "return")) @@ -91,6 +95,18 @@ p <- float str <- some (preStr ins) pure (p, str) "Probability/text pair" + +-- | Parse an `include` +-- TODO define semantics for variables and all that? +inclusions :: Parser [String] +inclusions = many $ 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. -- | Parse a `define` block definition :: [T.Text] -> Parser (Key, [(Prob, [PreTok])]) diff --git a/src/Text/Madlibs/Cata/SemErr.hs b/src/Text/Madlibs/Cata/SemErr.hs --- a/src/Text/Madlibs/Cata/SemErr.hs +++ b/src/Text/Madlibs/Cata/SemErr.hs @@ -53,6 +53,7 @@ checkSemantics :: [(Key, [(Prob, [PreTok])])] -> Parser [(Key, [(Prob, [PreTok])])] checkSemantics = foldr (<=<) pure [ checkReturn ] + -- | helper to filter out stuff that doesn't sumProb :: [(Prob, [PreTok])] -> Bool sumProb = ((==1) . sum . (map fst))