madlang 0.1.0.5 → 1.0.0.0

raw patch · 7 files changed

+95/−57 lines, 7 filesdep +gitrevdep ~madlang

Dependencies added: gitrev

Dependency ranges changed: madlang

Files

• madlang.cabal +7/−6
• src/Text/Madlibs.hs +1/−0
• src/Text/Madlibs/Ana/Parse.hs +33/−22
• src/Text/Madlibs/Exec/Main.hs +28/−12
• src/Text/Madlibs/Internal/Types.hs +6/−5
• test/Spec.hs +18/−12
• test/templates/var.mad +2/−0

@@ -1,5 +1,5 @@ name: madlang-version: 0.1.0.5+version: 1.0.0.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -33,7 +33,8 @@         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+        ansi-wl-pprint >=0.6.7.3 && <0.7,+        gitrev >=1.2.0 && <1.3     default-language: Haskell2010     default-extensions: OverloadedStrings DeriveGeneric DeriveFunctor                         DeriveAnyClass@@ -51,17 +52,17 @@     main-is: Main.hs     build-depends:         base >=4.9.1.0 && <4.10,-        madlang >=0.1.0.5 && <0.2+        madlang >=1.0.0.0 && <1.1     default-language: Haskell2010     hs-source-dirs: app-    ghc-options: -threaded -rtsopts -with-rtsopts=-N -O3 -fllvm -optlo-O3+    ghc-options: -threaded -rtsopts -with-rtsopts=-N  test-suite madlang-test     type: exitcode-stdio-1.0     main-is: Spec.hs     build-depends:         base >=4.9.1.0 && <4.10,-        madlang >=0.1.0.5 && <0.2,+        madlang >=1.0.0.0 && <1.1,         hspec >=2.4.1 && <2.5,         megaparsec >=5.2.0 && <5.3,         text >=1.2.2.1 && <1.3,@@ -69,4 +70,4 @@         hspec-megaparsec >=0.3.1 && <0.4     default-language: Haskell2010     hs-source-dirs: test-    ghc-options: -threaded -rtsopts -with-rtsopts=-N -O3 -fllvm+    ghc-options: -threaded -rtsopts -with-rtsopts=-N

@@ -1,3 +1,4 @@+ -- | Main module exporting the relevant functions module Text.Madlibs (                     -- * Parsers for `.mad` files

@@ -30,6 +30,9 @@ float :: Parser Prob float = lexeme L.float +integer :: Parser Integer+integer = lexeme L.integer+ -- | Make sure definition blocks start un-indented nonIndented = L.nonIndented spaceConsumer @@ -43,11 +46,16 @@ keyword :: String -> Parser String keyword str = (pure <$> char ':') <> (symbol str) <?> "keyword" +-- | Parse a var+var :: Parser Int+var = fromIntegral <$> do+    char '$'+    integer <?> "variable"+ -- | Parse the `define` keyword. define :: Parser () define = (void $ nonIndented (keyword "define"))     <?> "define block"-    --make them more similar/reuse code here!!  -- | Parse the `:return` keyword. main :: Parser ()@@ -59,51 +67,54 @@ name = lexeme (some letterChar) <?> "template name"  -- | Parse template into a `PreTok` of referents and strings-preStr :: Parser PreTok-preStr = (fmap (Name . T.pack) name) <|>+preStr :: [T.Text] -> Parser PreTok+preStr ins = (fmap (Name . T.pack) name) <|>     do {-    s <- quote (many $ noneOf ("\"\'" :: String)) ;-    pure $ PreTok . T.pack $ s+        v <- var ;+        pure . PreTok $ (<> " ") $ ins !! (v - 1)+    } <|>+    do {+        s <- quote (many $ noneOf ("\"\'" :: String)) ;+        pure $ PreTok . T.pack $ s     }      <?> "string or function name"  -- | Parse a probability/corresponding template-pair :: Parser (Prob, [PreTok])-pair = do+pair :: [T.Text] -> Parser (Prob, [PreTok])+pair ins = do     --indentGuard     p <- float-    str <- some $ preStr+    str <- some $ preStr ins     pure (p, str)  -- | Parse a `define` block-definition :: Parser (Key, [(Prob, [PreTok])])-definition = do+definition :: [T.Text] -> Parser (Key, [(Prob, [PreTok])])+definition ins = do     define     str <- name-    val <- some pair-    --linebreak+    val <- some $ pair ins     pure (T.pack str, val)  -- | Parse the `:return` block-final :: Parser [(Prob, [PreTok])]-final = do+final :: [T.Text] -> Parser [(Prob, [PreTok])]+final ins = do     main-    val <- some pair+    val <- some $ pair ins     pure val  -- | Parse the program in terms of `PreTok` and the `Key`s to link them.-program :: Parser [(Key, [(Prob, [PreTok])])]-program = sortKeys . checkSemantics <$> do-    p <- many (try definition <|> ((,) "Template" <$> final))+program :: [T.Text] -> Parser [(Key, [(Prob, [PreTok])])]+program ins = sortKeys . checkSemantics <$> do+    p <- many (try (definition ins) <|> ((,) "Template" <$> final ins))     pure p  -- | Parse text as a token + context (aka a reader monad with all the other functions)-parseTokM :: Parser (Context RandTok)-parseTokM = fmap build program+parseTokM :: [T.Text] -> Parser (Context RandTok)+parseTokM ins = fmap build $ program ins  -- | Parse text as a token -- -- > f <- readFile "template.mad" -- > parseTok f-parseTok :: T.Text -> Either (ParseError Char Dec) RandTok-parseTok f = snd . head . (filter (\(i,j) -> i == "Template")) . (flip execState []) <$> runParser parseTokM "" f+parseTok :: [T.Text] -> T.Text -> Either (ParseError Char Dec) RandTok+parseTok ins f = snd . head . (filter (\(i,j) -> i == "Template")) . (flip execState []) <$> runParser (parseTokM ins) "" f

@@ -5,6 +5,7 @@ -- | Provides `madlang` runMadlangutable module Text.Madlibs.Exec.Main where +import Control.Monad import Text.Madlibs.Cata.Run import Text.Madlibs.Ana.Parse import Text.Madlibs.Internal.Types@@ -13,11 +14,14 @@ import qualified Data.Text.IO as TIO import Text.Megaparsec import Options.Generic+import Development.GitRev  -- | datatype for the program data Program = Program { input :: FilePath <?> "filepath to template"-                       , debug :: Bool <?> "whether to display parsed RandTok" --also: display crontab in that case?+                       , debug :: Bool <?> "whether to display parsed RandTok"                         , rep :: Maybe Int <?> "How many times to repeat"+                       , v :: [String] <?> "Extra input to the template" --fix soon?+                       , version :: Bool <?> "Display version information for debugging"                        } deriving (Generic)  -- | Generated automatically by optparse-generic.@@ -27,34 +31,46 @@ runMadlang :: IO () runMadlang = do     x <- getRecord "Text.Madlibs templating DSL"+    if unHelpful . version $ x then putStrLn build else pure ()     case unHelpful . rep $ x of-        (Just n) -> sequence_ . (take n) . repeat $ template x+        (Just n) -> replicateM_ n $ template x         Nothing -> template x  -- | given a parsed record perform the appropriate IO action template :: Program -> IO () template rec = do     let filepath = unHelpful . input $ rec-    parsed <- parseFile filepath-    runFile filepath >>= TIO.putStrLn+    let ins = map T.pack $ (unHelpful . v $ rec)+    parsed <- parseFile ins filepath+    runFile ins filepath >>= TIO.putStrLn     if unHelpful . debug $ rec then         print parsed     else         pure ()  -- | Generate randomized text from a template-templateGen :: T.Text -> Either (ParseError Char Dec) (IO T.Text)-templateGen txt = run <$> parseTok txt+templateGen :: [T.Text] -> T.Text -> Either (ParseError Char Dec) (IO T.Text)+templateGen ins txt = run <$> parseTok ins txt  -- | Generate randomized text from a file conatining a template-runFile :: FilePath -> IO T.Text-runFile filepath = do+runFile :: [T.Text] -> FilePath -> IO T.Text+runFile ins filepath = do     txt <- readFile' filepath-    either (pure . parseErrorPretty') (>>= (pure . show')) (templateGen txt)+    either (pure . parseErrorPretty') (>>= (pure . show')) (templateGen ins txt)  -- | Parse a template file into the `RandTok` data type-parseFile :: FilePath -> IO (Either (ParseError Char Dec) RandTok)-parseFile filepath = do+parseFile :: [T.Text] -> FilePath -> IO (Either (ParseError Char Dec) RandTok)+parseFile ins filepath = do     txt <- readFile' filepath-    let val = parseTok txt+    let val = parseTok ins txt     pure val++-- | String with git commit string+build :: String+build = concat [ "[version: ", $(gitBranch), "@", $(gitHash)+               , " (", $(gitCommitDate), ")"+               , " (", $(gitCommitCount), " commits in HEAD)"+               , dirty, "] "] +    where+        dirty | $(gitDirty) = " (uncommitted files present)" +              | otherwise   = ""

@@ -9,6 +9,7 @@ import Data.Functor.Identity import Control.Lens hiding (List, Context) import Data.Function+import Data.Monoid  -- | datatype for a double representing a probability type Prob = Double@@ -17,11 +18,11 @@ type Key = T.Text  -- | Pretoken, aka token as first read in-data PreTok = Name T.Text | PreTok T.Text -    deriving (Show)+data PreTok = Name T.Text | PreTok T.Text+    deriving (Show, Eq)  -- | datatype for a token returning a random string-data RandTok = List [(Prob, RandTok)] | Value T.Text +data RandTok = List [(Prob, RandTok)] | Value T.Text     deriving (Show, Eq)  -- | Make `RandTok` a monoid so we can append them together nicely (since they do generate text). @@ -33,11 +34,11 @@     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) (`mappend` v)) l2-    mappend l@(List l1) (List l2) = List $ [ (p, l `mappend` tok) | (p,tok) <- l2 ]+    mappend l@(List l1) (List l2) = List [ (p, l `mappend` tok) | (p,tok) <- l2 ]  -- | State monad providing context, i.e. function we've already called before type Context a = State [(Key, RandTok)] a  -- | Compare inside the state monad using only the underlying objects instance (Eq a) => Eq (Context a) where-    (==) a b = (on (==) (flip evalState [])) a b+    (==) = (on (==) (flip evalState []))

@@ -14,18 +14,20 @@ main :: IO () main = hspec $ do     describe "parseTok" $ do-        it "parses a .mad string" $ do-            parseTok madFile `shouldParse` (List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])])-        it "fails when quotes aren't closed" $ do-            parseTok `shouldFailOn` madFileFailure-        it "parses when functions are out of order" $ do-            parseTok `shouldSucceedOn` madComplexFile-        it "returns a correct string from the template when evaluating a token" $ do+        parallel$ it "parses a .mad string" $ do+            parseTok [] madFile `shouldParse` (List [(1.0,List [(0.5,Value "heads"),(0.5,Value "tails")])])+        parallel $ it "fails when quotes aren't closed" $ do+            parseTok [] `shouldFailOn` madFileFailure+        parallel $ it "parses when functions are out of order" $ do+            parseTok [] `shouldSucceedOn` madComplexFile+        parallel $ it "returns a correct string from the template when evaluating a token" $ do             (testIO . run) exampleTok `shouldSatisfy` (\a -> on (||) (a ==) "heads" "tails")-        it "throws exception when two `:return`s are declared" $ do-            (parseTok `shouldFailOn` semErrFile) `shouldThrow` semErr-            --this is still behaving weirdly but I don't care-            --also we need a parse error one but that shouldn't be too hard idk+        parallel $ it "throws exception when two `:return`s are declared" $ do+            (parseTok [] `shouldFailOn` semErrFile) `shouldThrow` semErr+        parallel $ it "substitutes a variable correctly" $ do+            parseTok ["maxine"] `shouldSucceedOn` madVar+        parallel $ it "fails when variables are not passed in" $ do+            (parseTok [] `shouldFailOn` madVar) `shouldThrow` anyException  semErr :: Selector SemanticError semErr = const True@@ -65,7 +67,11 @@ \    1.0 something\ \:return\ \    0.5 something\-\    0.5 \"it doesn't matter b/c this is gonna blow up in our faces anyways\""+\    0.5 \"parallel$ it doesn't matter b/c this is gonna blow up in our faces anyways\""++madVar :: T.Text+madVar = ":return\+\    1.0 $1 \" is a good doggo.\""  -- | for the testing framework; to  testIO :: IO a -> a

@@ -0,0 +1,2 @@+:return+    1.0 $1 " is a good doggo."