madlang 2.1.1.0 → 2.1.1.1
raw patch · 14 files changed
+223/−66 lines, 14 filesdep +random-shuffledep −template-haskelldep −tibetan-utilsdep ~madlang
Dependencies added: random-shuffle
Dependencies removed: template-haskell, tibetan-utils
Dependency ranges changed: madlang
Files
- bench/Bench.hs +2/−2
- bench/templates/magical-realism.mad +0/−38
- default.nix +22/−0
- demo/shakespeare.mad +156/−0
- madlang.cabal +9/−9
- release.nix +5/−0
- src/Text/Madlibs/Ana/Parse.hs +8/−9
- src/Text/Madlibs/Ana/ParseUtils.hs +10/−1
- src/Text/Madlibs/Ana/Resolve.hs +3/−0
- src/Text/Madlibs/Cata/SemErr.hs +2/−2
- stack.yaml +1/−1
- test/Spec.hs +2/−2
- test/templates/gambling.mad +1/−1
- test/templates/modifiers.mad +2/−1
bench/Bench.hs view
@@ -9,8 +9,8 @@ main = do file <- TIO.readFile "test/templates/fortune-teller.mad"- file2 <- TIO.readFile "bench/templates/magical-realism.mad"+ file2 <- TIO.readFile "demo/shakespeare.mad" defaultMain [ bgroup "parseFile" [ bench "fortune-teller" $ whnf fun file - , bench "magical-realism" $ whnf fun file2 ]+ , bench "shakespeare" $ whnf fun file2 ] ]
− bench/templates/magical-realism.mad
@@ -1,38 +0,0 @@-: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
+ default.nix view
@@ -0,0 +1,22 @@+{ mkDerivation, ansi-wl-pprint, base, composition, containers+, directory, hspec, hspec-megaparsec, megaparsec, microlens, mtl+, mwc-random, optparse-applicative, random-shuffle, stdenv, text+}:+mkDerivation {+ pname = "madlang";+ version = "2.1.1.0";+ src = ./.;+ isLibrary = true;+ isExecutable = true;+ libraryHaskellDepends = [+ ansi-wl-pprint base composition containers directory megaparsec+ microlens mtl mwc-random optparse-applicative random-shuffle text+ ];+ executableHaskellDepends = [ base ];+ testHaskellDepends = [+ base hspec hspec-megaparsec megaparsec mtl text+ ];+ homepage = "https://github.com/vmchale/madlang#readme";+ description = "Randomized templating language DSL";+ license = stdenv.lib.licenses.bsd3;+}
+ demo/shakespeare.mad view
@@ -0,0 +1,156 @@+:define adjective+ 1.0 "artless"+ 1.0 "base-court"+ 1.0 "bawdy"+ 1.0 "bat-fowling"+ 1.0 "beslubbering"+ 1.0 "beef-witted"+ 1.0 "bootless"+ 1.0 "beetle-headed"+ 1.0 "churlish"+ 1.0 "boil-brained"+ 1.0 "cockered"+ 1.0 "clapper-clawed"+ 1.0 "clouted"+ 1.0 "clay-brained"+ 1.0 "craven"+ 1.0 "common-kissing"+ 1.0 "currish"+ 1.0 "crook-pated"+ 1.0 "dankish"+ 1.0 "dismal-dreaming"+ 1.0 "dissembling"+ 1.0 "dizzy-eyed"+ 1.0 "droning"+ 1.0 "doghearted"+ 1.0 "errant"+ 1.0 "dread-bolted"+ 1.0 "fawning"+ 1.0 "earth-vexing"+ 1.0 "fobbing"+ 1.0 "elf-skinned"+ 1.0 "froward"+ 1.0 "fat-kidneyed"+ 1.0 "frothy"+ 1.0 "fen-sucked"+ 1.0 "gleeking"+ 1.0 "flap-mouthed"+ 1.0 "goatish"+ 1.0 "fly-bitten"+ 1.0 "gorbellied"+ 1.0 "folly-fallen"+ 1.0 "impertinent"+ 1.0 "fool-born"+ 1.0 "infectious"+ 1.0 "full-gorged"+ 1.0 "jarring"+ 1.0 "guts-griping"+ 1.0 "loggerheaded"+ 1.0 "half-faced"+ 1.0 "lumpish"+ 1.0 "hasty-witted"+ 1.0 "mammering"+ 1.0 "hedge-born"+ 1.0 "mangled"+ 1.0 "hell-hated"+ 1.0 "mewling"+ 1.0 "idle-headed"+ 1.0 "paunchy"+ 1.0 "ill-breeding"+ 1.0 "pribbling"+ 1.0 "ill-nurtured"+ 1.0 "puking"+ 1.0 "knotty-pated"+ 1.0 "puny"+ 1.0 "milk-livered"+ 1.0 "qualling"+ 1.0 "motley-minded"+ 1.0 "rank"+ 1.0 "onion-eyed"+ 1.0 "reeky"+ 1.0 "plume-plucked"+ 1.0 "roguish"+ 1.0 "pottle-deep"+ 1.0 "ruttish"+ 1.0 "pox-marked"+ 1.0 "saucy"+ 1.0 "reeling-ripe"+ 1.0 "spleeny"+ 1.0 "rough-hewn"+ 1.0 "spongy"+ 1.0 "rude-growing"+ 1.0 "surly"+ 1.0 "rump-fed"+ 1.0 "tottering"+ 1.0 "shard-borne"+ 1.0 "unmuzzled"+ 1.0 "sheep-biting"+ 1.0 "vain"+ 1.0 "spur-galled"+ 1.0 "venomed"+ 1.0 "swag-bellied"+ 1.0 "villainous"+ 1.0 "tardy-gaited"+ 1.0 "warped"+ 1.0 "tickle-brained"+ 1.0 "wayward"+ 1.0 "toad-spotted"+ 1.0 "weedy"+ 1.0 "unchin-snouted"+ 1.0 "yeasty"+ 1.0 "weather-bitten"++:define noun+ 1.0 "apple-john"+ 1.0 "baggage"+ 1.0 "barnacle"+ 1.0 "bladder"+ 1.0 "boar-pig"+ 1.0 "bugbear"+ 1.0 "bum-bailey"+ 1.0 "canker-blossom"+ 1.0 "clack-dish"+ 1.0 "clotpole"+ 1.0 "coxcomb"+ 1.0 "codpiece"+ 1.0 "death-token"+ 1.0 "dewberry"+ 1.0 "flap-dragon"+ 1.0 "flax-wench"+ 1.0 "flirt-gill"+ 1.0 "foot-licker"+ 1.0 "fustilarian"+ 1.0 "giglet"+ 1.0 "gudgeon"+ 1.0 "haggard"+ 1.0 "harpy"+ 1.0 "hedge-pig"+ 1.0 "horn-beast"+ 1.0 "hugger-mugger"+ 1.0 "joithead"+ 1.0 "lewdster"+ 1.0 "lout"+ 1.0 "maggot-pie"+ 1.0 "malt-worm"+ 1.0 "mammet"+ 1.0 "measle"+ 1.0 "minnow"+ 1.0 "miscreant"+ 1.0 "moldwarp"+ 1.0 "mumble-news"+ 1.0 "nut-hook"+ 1.0 "pigeon-egg"+ 1.0 "pignut"+ 1.0 "puttock"+ 1.0 "pumpion"+ 1.0 "ratsbane"+ 1.0 "scut"+ 1.0 "skainsmate"+ 1.0 "strumpet"+ 1.0 "varlot"+ 1.0 "vassal"+ 1.0 "whey-face"+ 1.0 "wagtail"++:return+ 1.0 "Thou " adjective " " adjective " " noun "!"
madlang.cabal view
@@ -1,5 +1,5 @@ name: madlang-version: 2.1.1.0+version: 2.1.1.1 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -22,7 +22,9 @@ test/templates/include.mad test/templates/modifiers.mad test/templates/err/*.mad- bench/templates/*.mad+ demo/shakespeare.mad+ default.nix+ release.nix stack.yaml bash/mkCompletions @@ -46,15 +48,13 @@ composition >=1.0.2.1 && <1.1, directory >=1.3.0.0 && <1.4, mwc-random >=0.13.5.0 && <0.14,- template-haskell >=2.11.1.0 && <2.12,+ random-shuffle >=0.0.4 && <0.1, microlens >=0.4.8.0 && <0.5, 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+ containers >=0.5.7.1 && <0.6 default-language: Haskell2010 default-extensions: OverloadedStrings DeriveGeneric DeriveFunctor- DeriveAnyClass hs-source-dirs: src other-modules: Text.Madlibs.Ana.ParseUtils@@ -75,7 +75,7 @@ main-is: Main.hs build-depends: base >=4.9.1.0 && <4.10,- madlang >=2.1.1.0 && <2.2+ madlang >=2.1.1.1 && <2.2 default-language: Haskell2010 hs-source-dirs: app @@ -84,7 +84,7 @@ main-is: Spec.hs build-depends: base >=4.9.1.0 && <4.10,- madlang >=2.1.1.0 && <2.2,+ madlang >=2.1.1.1 && <2.2, hspec >=2.4.3 && <2.5, megaparsec >=5.2.0 && <5.3, text >=1.2.2.1 && <1.3,@@ -105,7 +105,7 @@ build-depends: base >=4.9.1.0 && <4.10, criterion >=1.1.4.0 && <1.2,- madlang >=2.1.1.0 && <2.2,+ madlang >=2.1.1.1 && <2.2, megaparsec >=5.2.0 && <5.3, text >=1.2.2.1 && <1.3 default-language: Haskell2010
+ release.nix view
@@ -0,0 +1,5 @@+let+ pkgs = import <nixpkgs> { };++in+ pkgs.haskell.lib.justStaticExecutables (pkgs.haskellPackages.callPackage ./default.nix { })
src/Text/Madlibs/Ana/Parse.hs view
@@ -15,7 +15,6 @@ import qualified Data.Map as M import Control.Monad.State import Control.Exception hiding (try)-import Data.Char import Data.Composition -- | Parse a lexeme, aka deal with whitespace nicely. @@ -81,28 +80,28 @@ modifier :: Parser (T.Text -> T.Text) modifier = do char '.'- str <- try (string "to_upper") <|> (string "to_lower") - let modifiers = M.fromList [("to_upper", T.map toUpper), ("to_lower", T.map toLower)] in - pure $ maybe id id (M.lookup str modifiers)+ str <- try (string "to_upper") <|> (string "to_lower")+ pure $ maybe id id (M.lookup str modifierList) -- | Parse template into a `PreTok` of referents and strings preStr :: [T.Text] -> Parser PreTok preStr ins = do { n <- name ;- mod <- optional $ modifier ;+ mod <- many $ modifier ; spaceConsumer ;- pure $ Name (T.pack n) (maybe id id mod)+ pure $ Name (T.pack n) (foldr (.) id mod) } <|> do { v <- var ;+ mod <- many $ modifier ; spaceConsumer ;- pure . PreTok $ ins `access` (v-1) -- ins !! (v - 1)+ pure . PreTok . (foldr (.) id mod) $ ins `access` (v-1) -- ins !! (v - 1) } <|> do { s <- quote (many $ noneOf ("\n\"" :: String)) ;- mod <- optional $ modifier ;+ mod <- many $ modifier ; -- TODO: parse many via a fold? spaceConsumer ;- pure $ PreTok . (maybe id id mod) . T.pack $ s+ pure . PreTok . (foldr (.) id mod) . T.pack $ s } <?> "string or function name"
src/Text/Madlibs/Ana/ParseUtils.hs view
@@ -10,9 +10,18 @@ import Data.Foldable import Control.Exception import Control.Arrow+import System.Random.Shuffle+import qualified Data.Map as M+import Data.Char --TODO consider moving Ana.ParseUtils to Cata.Sorting +modifierList :: M.Map String (T.Text -> T.Text)+modifierList = M.fromList [("to_upper", T.map toUpper), ("to_lower", T.map toLower)]++jumble :: T.Text -> IO T.Text+jumble = (fmap (T.pack . unwords)) . shuffleM . words . T.unpack+ strip = T.pack . reverse . drop 4 . reverse -- | Get the :return value@@ -33,7 +42,7 @@ buildTok param pretoks = do ctx <- get let unList (List a) = a- let toRand (Name str f) = (apply f) . List . snd . (head' str param) . (filter ((==str) . fst)) . (map (second unList)) $ ctx -- TODO use modifier alongside name?+ let toRand (Name str f) = (apply f) . List . snd . (head' str param) . (filter ((==str) . fst)) . (map (second unList)) $ ctx toRand (PreTok txt) = Value txt List . zip ([1..]) . (map toRand) <$> pretoks
src/Text/Madlibs/Ana/Resolve.hs view
@@ -34,6 +34,9 @@ runInFolder :: [T.Text] -> FilePath -> FilePath -> IO T.Text runInFolder = ((either (pure . parseErrorPretty') (>>= (pure . show'))) =<<) .** (fmap (fmap run) .** parseFile) +runText :: [T.Text] -> String -> T.Text -> IO T.Text+runText vars name txt = (either (pure . parseErrorPretty') id) . (fmap run) $ (parseTok name [] vars txt)+ -- | Get file as context parseCtx :: Bool -> [T.Text] -> [(Key, RandTok)] -> FilePath -> IO (Either (ParseError Char Dec) [(Key, RandTok)]) parseCtx isTree ins state filepath = do
src/Text/Madlibs/Cata/SemErr.hs view
@@ -18,7 +18,7 @@ -- | display a `SemanticError` nicely with coloration & whatnot instance Show SemanticError where- show OverloadedReturns = show $ semErrStart <> text "File contains multiple declarations of :return"+ show OverloadedReturns = show $ semErrStart <> text "File must contain exactly one declaration of :return" show (CircularFunctionCalls f1 f2) = show $ semErrStart <> text "Circular function declaration between:" <> indent 4 (yellow $ (text' f1) <> (text ", ") <> (text' f2)) show (InsufficientArgs i j) = show $ semErrStart <> text "Insufficent arguments from the command line, given " <> (text . show $ i) <> ", expected at least " <> (text . show $ j) @@ -52,7 +52,7 @@ -- | big semantics checker that sequences stuff checkSemantics :: [(Key, [(Prob, [PreTok])])] -> Parser [(Key, [(Prob, [PreTok])])] checkSemantics = foldr (<=<) pure [ checkReturn- ]+ ] -- do we need this all to be in a monad? -- | helper to filter out stuff that doesn't sumProb :: [(Prob, [PreTok])] -> Bool
stack.yaml view
@@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml"-resolver: nightly-2017-04-10+resolver: lts-8.11 # User packages to be built. # Various formats can be used as shown in the example below.
test/Spec.hs view
@@ -39,8 +39,8 @@ -- file <- madFileTibetan -- parseTok "" [] file `shouldParse` (List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])]) describe "runFile" $ do- parallel $ it "parses nested modifiers correctly" $ \file -> do- runFile [] "test/templates/modifiers.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["AAAaaa","AAAaa","AAaaa","AAaa"]))+ parallel $ it "parses nested modifiers and modifiers on variables correctly" $ \file -> do+ runFile ["aa"] "test/templates/modifiers.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["AAAaaa","AAAaa","AAaaa","AAaa"])) parallel $ it "parses file with inclusions and modifiers on functions" $ \file -> do runFile [] "test/templates/include.mad" >>= (`shouldSatisfy` (\a -> any (a==) ["heads","tails","on its side"])) parallel $ it "runs on a file out of order" $ \file -> do
test/templates/gambling.mad view
@@ -1,5 +1,5 @@ :define something- 0.5 "heads".to_upper+ 0.5 "heads".to_upper.to_upper 0.5 "tailS".to_lower :return 1.0 something
test/templates/modifiers.mad view
@@ -1,7 +1,8 @@ :define scream 1.0 "aaa".to_upper 1.0 "aa".to_upper+ 1.0 $1.to_upper :define sedated- 1.0 scream.to_lower+ 1.0 scream.to_lower.to_upper.to_lower :return 1.0 scream sedated