diff --git a/madlang.cabal b/madlang.cabal --- a/madlang.cabal +++ b/madlang.cabal @@ -1,110 +1,102 @@ -name: madlang -version: 2.1.0.1 -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/ordered.mad - test/templates/include.mad - test/templates/err/*.mad - bench/templates/*.mad - stack.yaml - bash/mkCompletions - -source-repository head - type: git - location: https://github.com/vmchale/madlang +name: madlang +version: 2.1.0.2 +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/ordered.mad + , test/templates/include.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, - composition >=1.0.2.1 && <1.1, - directory >=1.3.0.0 && <1.4, - mwc-random >=0.13.5.0 && <0.14, - 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, - lens >=4.15.1 && <4.16 - 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.Ana.Resolve - 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.Ana.Resolve + , 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 + , composition + , directory + , mwc-random + , mtl + , ansi-wl-pprint + , containers + , tibetan-utils + , lens + 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.1.0.1 && <2.2 - 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.1.0.1 && <2.2, - hspec >=2.4.3 && <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 -benchmark tweeths-bench - - if flag(llvm-fast) - ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3 - else - ghc-options: -threaded -rtsopts -with-rtsopts=-N -O3 - type: exitcode-stdio-1.0 - main-is: Bench.hs - build-depends: - base >=4.9.1.0 && <4.10, - criterion >=1.1.4.0 && <1.2, - madlang >=2.1.0.1 && <2.2, - megaparsec >=5.2.0 && <5.3, - text >=1.2.2.1 && <1.3 - default-language: Haskell2010 - hs-source-dirs: bench +source-repository head + type: git + location: https://github.com/vmchale/madlang 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 @@ -9,23 +9,31 @@ import Text.Madlibs.Ana.ParseUtils import Text.Madlibs.Cata.Run import Data.Composition +import System.Directory -- | 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) +parseFile :: [T.Text] -> FilePath -> 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 +getInclusionCtx :: Bool -> [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char Dec) [(Key, RandTok)]) +getInclusionCtx isTree ins folder filepath = do + file <- readFile' (folder ++ 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 + ctx <- mapM (getInclusionCtx isTree ins folder) filenames + parseCtx isTree ins (concatMap (either (const []) id) ctx) (folder ++ 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) +runFile ins toFolder = do + exists <- doesDirectoryExist (getDir 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) + -- | Get file as context parseCtx :: Bool -> [T.Text] -> [(Key, RandTok)] -> FilePath -> IO (Either (ParseError Char Dec) [(Key, RandTok)]) parseCtx isTree ins state filepath = do @@ -34,5 +42,5 @@ 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) +makeTree :: [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char Dec) RandTok) +makeTree = fmap (fmap takeTemplate) .** (getInclusionCtx True) diff --git a/src/Text/Madlibs/Exec/Main.hs b/src/Text/Madlibs/Exec/Main.hs --- a/src/Text/Madlibs/Exec/Main.hs +++ b/src/Text/Madlibs/Exec/Main.hs @@ -86,10 +86,10 @@ let ins = map T.pack $ (clInputs . sub $ rec) case sub rec of (Run reps _) -> do - parsed <- parseFile ins filepath + parsed <- parseFile ins "" filepath replicateM_ (maybe 1 id reps) $ runFile ins filepath >>= TIO.putStrLn (Debug _) -> do - putStr . (either show displayTree) =<< makeTree ins filepath + putStr . (either show displayTree) =<< makeTree ins "" filepath (Lint _) -> do - parsed <- parseFile ins filepath + parsed <- parseFile ins "" filepath putStrLn $ either parseErrorPretty (const "No syntax errors found.") parsed diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -39,8 +39,10 @@ -- file <- madFileTibetan -- parseTok "" [] file `shouldParse` (List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])]) describe "runFile" $ do - it "parses file with inclusions" $ do - runFile [] "test/templates/ordered.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["heads","tails","on its side"])) + parallel $ before (readFile' "test/templates/include.mad") $ it "parses file with inclusions" $ \file -> do + runFile [] "test/templates/include.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["heads","tails","on parallel $ its side"])) + parallel $ before (readFile' "test/templates/ordered.mad") $ it "runs on a file out of order" $ \file -> do + runFile [] "test/templates/ordered.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["heads","tails","one","two","three","thid"])) semErr :: Selector SemanticError semErr = const True diff --git a/test/templates/ordered.mad b/test/templates/ordered.mad --- a/test/templates/ordered.mad +++ b/test/templates/ordered.mad @@ -1,14 +1,16 @@ +:define somethingelse + 1.0 "one" + 1.0 "two" + 1.0 "three" + :define something 1.0 "heads" 1.0 "tails" 1.0 somethingelse + 1.0 athirdthing -:define somethingelse - 1.0 "1" - 1.0 "2" - 1.0 "3" - 1.0 "4" - 1.0 "5" +:define athirdthing + 1.0 "third" :return 1.0 something