madlang 2.4.0.2 → 2.4.1.0
raw patch · 6 files changed
+56/−55 lines, 6 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- madlang.cabal +20/−25
- src/Text/Madlibs/Ana/ParseUtils.hs +13/−2
- src/Text/Madlibs/Cata/SemErr.hs +1/−1
- src/Text/Madlibs/Exec/Main.hs +17/−17
- src/Text/Madlibs/Internal/Types.hs +5/−4
- stack.yaml +0/−6
madlang.cabal view
@@ -1,5 +1,5 @@ name: madlang-version: 2.4.0.2+version: 2.4.1.0 synopsis: Randomized templating language DSL description: Please see README.md homepage: https://github.com/vmchale/madlang#readme@@ -17,10 +17,15 @@ , demo/*.mad , default.nix , release.nix- , stack.yaml , bash/mkCompletions cabal-version: >=1.10 +Flag development {+ Description: Turn on '-Werror'+ Default: False+ Manual: True+}+ Flag llvm-fast { Description: Enable build with llvm backend (produces a faster executable) Default: False@@ -31,11 +36,6 @@ Default: False } -Flag gold {- Description: Enable the gold linker for faster build times- Default: True-}- library hs-source-dirs: src exposed-modules: Text.Madlibs@@ -50,7 +50,7 @@ , Text.Madlibs.Cata.Display , Text.Madlibs.Exec.Main , Paths_madlang- build-depends: base >= 4.7 && < 5+ build-depends: base >= 4.8 && < 5 , megaparsec >= 6.0 , text , optparse-applicative@@ -58,7 +58,6 @@ , MonadRandom , composition , composition-extra- -- , dhall , directory , file-embed , random-shuffle@@ -71,10 +70,9 @@ , DeriveGeneric , DeriveFunctor , DeriveAnyClass- if flag(gold)- ghc-options: -optl-fuse-ld=gold- ld-options: -fuse-ld=gold- ghc-options: -fwarn-unused-imports+ if flag(development)+ ghc-options: -Werror+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates executable madlang if flag(library)@@ -85,10 +83,9 @@ main-is: Main.hs if flag(llvm-fast) ghc-options: -fllvm -O3 -optlo-O3 -opta-march=native -opta-mtune=native- if flag(gold)- ghc-options: -optl-fuse-ld=gold - ld-options: -fuse-ld=gold- ghc-options: -threaded -rtsopts+ if flag(development)+ ghc-options: -Werror+ ghc-options: -rtsopts -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: base , madlang default-language: Haskell2010@@ -104,10 +101,9 @@ , text if flag(llvm-fast) ghc-options: -fllvm -optlo-O3 -O3 -fwarn-unused-imports- if flag(gold)- ghc-options: -optl-fuse-ld=gold- ld-options: -fuse-ld=gold- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O3 -fwarn-unused-imports+ if flag(development)+ ghc-options: -Werror+ ghc-options: -rtsopts -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -O3 default-language: Haskell2010 test-suite madlang-test@@ -122,10 +118,9 @@ , text , mtl , hspec-megaparsec- if flag(gold)- ghc-options: -optl-fuse-ld=gold- ld-options: -fuse-ld=gold- ghc-options: -threaded -rtsopts -with-rtsopts=-N -fwarn-unused-imports+ if flag(development)+ ghc-options: -Werror+ ghc-options: -threaded -rtsopts -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -with-rtsopts=-N default-language: Haskell2010 source-repository head
src/Text/Madlibs/Ana/ParseUtils.hs view
@@ -16,6 +16,8 @@ import Data.List import qualified Data.Map as M import qualified Data.Text as T+import Debug.Trace+import Debug.Trace import System.Random.Shuffle import Text.Madlibs.Cata.SemErr import Text.Madlibs.Internal.Types@@ -97,6 +99,13 @@ orderHelper :: Key -> [(Prob, [PreTok])] -> Bool orderHelper key = any (\pair -> key `elem` (map unTok . snd $ pair)) +hasNoDeps :: [(Prob, [PreTok])] -> Bool+hasNoDeps = all isPreTok . concatMap snd+ where isPreTok PreTok{} = True+ isPreTok x = False++-- TODO 'somethingelse' shouldn't be less than 'athirdthing'!!+ -- | Ordering on the keys to account for dependency orderKeys :: (Key, [(Prob, [PreTok])]) -> (Key, [(Prob, [PreTok])]) -> Ordering orderKeys (key1, l1) (key2, l2)@@ -104,9 +113,11 @@ | key2 == "Return" = LT | orderHelper key1 l2 = LT | orderHelper key2 l1 = GT- | any (flip orderHelper l1) (flatten l2) = LT -- FIXME needs to not default to `EQ` when transitive dependencies are a thing.+ | any (flip orderHelper l1) (flatten l2) = LT | any (flip orderHelper l2) (flatten l1) = GT- | otherwise = EQ+ | hasNoDeps l1 = LT+ | hasNoDeps l2 = GT+ | otherwise = EQ -- FIXME transitive dependencies flatten :: [(Prob, [PreTok])] -> [Key] flatten = concatMap (map unTok . snd)
src/Text/Madlibs/Cata/SemErr.hs view
@@ -34,7 +34,7 @@ show (DoubleDefinition f) = show $ semErrStart <> text "File contains two declarations of:" <> indent 4 (yellow (text' f)) show NoReturn = show $ semErrStart <> text "File must contain exactly one declaration of :return" show (NoContext f1) = show $ semErrStart <> text "Call in function: " <> indent 4 (yellow (text' f1)) <> "which is not in scope"- show (CircularFunctionCalls f1 f2) = show $ semErrStart <> text "Function" </> indent 4 (yellow (text' f2)) <> text' " refers to a function" </> indent 4 (yellow (text' f1)) <> text' ", which is not in scope." </> indent 2 (text' "This may be due to circular function dependecies.")+ show (CircularFunctionCalls f1 f2) = show $ semErrStart <> text "Function" </> indent 4 (yellow (text' f2)) <> text' " refers to a function" </> indent 4 (yellow (text' f1)) <> text' ", which is not in scope." </> indent 2 (text' "This may be due to a circular function dependecy.") show (InsufficientArgs i j) = show $ semErrStart <> text "Insufficent arguments from the command line; given " <> (text . show $ i) <> ", expected at least " <> (text . show $ j) -- | Derived via our show instance;
src/Text/Madlibs/Exec/Main.hs view
@@ -2,19 +2,19 @@ module Text.Madlibs.Exec.Main ( runMadlang ) where -import Control.Monad-import Text.Madlibs.Ana.Resolve-import Text.Madlibs.Cata.Display-import Text.Madlibs.Internal.Utils-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import Text.Megaparsec-import Options.Applicative hiding (ParseError)-import Data.Monoid-import Data.Maybe-import System.Directory-import Paths_madlang-import Data.Version+import Control.Monad+import Data.Maybe+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import Data.Version+import Options.Applicative hiding (ParseError)+import Paths_madlang+import System.Directory+import Text.Madlibs.Ana.Resolve+import Text.Madlibs.Cata.Display+import Text.Madlibs.Internal.Utils+import Text.Megaparsec -- | datatype for the program data Program = Program { sub :: Subcommand }@@ -42,7 +42,7 @@ <> help "Number of times to repeat")) <*> (many $ strOption (short 'i'- <> metavar "VAR"+ <> metavar "VAR" <> help "command-line inputs to the template.")) <*> (argument str (metavar "FILEPATH"@@ -75,7 +75,7 @@ -- > $ madlang run example.mad -- > some text generated runMadlang :: IO ()-runMadlang = execParser wrapper >>= template +runMadlang = execParser wrapper >>= template versionInfo = infoOption ("madlang version: " ++ showVersion version) (short 'v' <> long "version" <> help "Show version") @@ -95,8 +95,8 @@ case sub rec of (Run reps _ _) -> do parsed <- parseFile ins "" filepath- replicateM_ (fromMaybe 1 reps) $ runFile ins filepath >>= TIO.putStrLn - (Debug _) -> putStr . (either show displayTree) =<< makeTree ins "" filepath + replicateM_ (fromMaybe 1 reps) $ runFile ins filepath >>= TIO.putStrLn+ (Debug _) -> putStr . (either show displayTree) =<< makeTree ins "" filepath (Lint _ _) -> do parsed <- parseFile ins "" filepath putStrLn $ either parseErrorPretty (const "No syntax errors found.") parsed
src/Text/Madlibs/Internal/Types.hs view
@@ -6,6 +6,7 @@ import Control.Monad.State import Data.Function+import Data.Monoid import qualified Data.Text as T import Lens.Micro @@ -19,7 +20,7 @@ data PreTok = Name T.Text (T.Text -> T.Text) | PreTok T.Text instance Show PreTok where- show (Name t _) = show t+ show (Name t _) = show ("lambda: " <> t) show (PreTok t) = show t instance Eq PreTok where@@ -42,8 +43,8 @@ instance Monoid RandTok where mempty = Value "" mappend (Value v1) (Value v2) = Value (T.append v1 v2)- mappend (List l1) v@(Value v1) = List $ map (over (_2) (`mappend` v)) l1- mappend v@(Value v2) (List l2) = List $ map (over (_2) (v `mappend`)) l2+ mappend (List l1) v@(Value v1) = List $ map (over _2 (`mappend` v)) l1+ mappend v@(Value v2) (List l2) = List $ map (over _2 (mappend v)) l2 mappend l@(List l1) (List l2) = List [ (p, l `mappend` tok) | (p,tok) <- l2 ] -- TODO make this a map instead of keys for faster parse.@@ -52,4 +53,4 @@ -- | Compare inside the state monad using only the underlying objects instance (Eq a) => Eq (Context a) where- (==) = (on (==) (flip evalState []))+ (==) = on (==) (flip evalState [])
− stack.yaml
@@ -1,6 +0,0 @@-resolver: lts-9.0-packages:-- .-extra-deps: []-flags: {}-extra-package-dbs: []