madlang 3.0.0.1 → 3.0.0.3

raw patch · 4 files changed

+25/−16 lines, 4 filesdep +titlecasedep ~basedep ~composition-preludesetup-changed

Dependencies added: titlecase

Dependency ranges changed: base, composition-prelude

Files

• Setup.hs +3/−6
• madlang.cabal +2/−2
• src/Text/Madlibs/Ana/ParseUtils.hs +15/−8
• test/templates/ordered.mad +5/−0

@@ -1,15 +1,12 @@-{-# LANGUAGE TemplateHaskell #-}- import           Control.Monad       (unless, void)-import           Data.FileEmbed      (embedStringFile) import           Data.Maybe import           Distribution.Simple import           System.Directory    (createDirectoryIfMissing) import           System.Environment  (lookupEnv) import           System.Process      (readCreateProcessWithExitCode, shell) -manpage :: String-manpage = $(embedStringFile "man/madlang.1")+manpage :: IO String+manpage = readFile "man/madlang.1"  main :: IO () main = setManpath >>@@ -36,7 +33,7 @@         Just x -> do             let manPath = x ++ "/.local/share/man/man1"             createDirectoryIfMissing True manPath-            writeFile (manPath ++ "/madlang.1") manpage+            writeFile (manPath ++ "/madlang.1") =<< manpage         Nothing -> pure ()  -- TODO only write if we can't find our own thing!

@@ -1,5 +1,5 @@ name:                madlang-version:             3.0.0.1+version:             3.0.0.3 synopsis:            Randomized templating language DSL description:         Madlang is a text templating language written in Haskell,                      meant to explore computational creativity and generative@@ -24,7 +24,6 @@ custom-setup   setup-depends:   base                  , Cabal-                 , file-embed                  , directory                  , process >= 1.4.0.0 @@ -72,6 +71,7 @@                      , mtl                      , ansi-wl-pprint                      , containers+                     , titlecase                      , http-client                      , tar                      , zlib

@@ -18,7 +18,10 @@ import           Data.Foldable import           Data.List import qualified Data.Map                    as M+import           Data.Maybe                  (catMaybes, fromJust)+import           Data.Monoid import qualified Data.Text                   as T+import           Data.Text.Titlecase import           System.Random.Shuffle import           Text.Madlibs.Cata.SemErr import           Text.Madlibs.Internal.Types@@ -32,7 +35,7 @@     , ("to_lower", T.map toLower)     , ("capitalize", \t -> toUpper (T.head t) `T.cons` T.tail t)     , ("reverse", T.reverse)-    , ("titlecase", T.unwords . fmap (\t -> toUpper (T.head t) `T.cons` (T.tail t)) . T.words)+    , ("titlecase", T.pack . titlecase . T.unpack) -- FIXME this improperly trims spaces at beginning/end of a word     , ("reverse_words", T.unwords . reverse . T.words)     , ("oulipo", T.filter (/='e'))] @@ -97,7 +100,7 @@  -- | Sort the keys that we have parsed so that dependencies are in the correct places sortKeys :: [(Key, [(Prob, [PreTok])])] -> [(Key, [(Prob, [PreTok])])]-sortKeys = sortBy orderKeys+sortKeys = sortBy =<< orderKeys  orderHelper :: Key -> [(Prob, [PreTok])] -> Bool orderHelper key = any (\pair -> key /= "" && key `elem` (map unTok . snd $ pair))@@ -107,13 +110,15 @@     where isPreTok PreTok{} = True           isPreTok _        = False --- FIXME if a depends on b depends on c, then we shouldn't consider a and c to be equal.--- Consider some fancy morphism here too. (chronomorphism? - comonad to pop--- values off, monad to store things.)+allDeps :: [(Key, [(Prob, [PreTok])])] -> Key -> [Key]+allDeps context key = let deps = (catMaybes . fmap maybeName . getNames) context in deps <> (allDeps context =<< deps)+    where getNames = (=<<) snd . fromJust . lookup key+          maybeName (Name n _) = Just n+          maybeName _          = Nothing  -- | Ordering on the keys to account for dependency-orderKeys :: (Key, [(Prob, [PreTok])]) -> (Key, [(Prob, [PreTok])]) -> Ordering-orderKeys (key1, l1) (key2, l2)+orderKeys :: [(Key, [(Prob, [PreTok])])] -> (Key, [(Prob, [PreTok])]) -> (Key, [(Prob, [PreTok])]) -> Ordering+orderKeys context (key1, l1) (key2, l2)     | key1 == "Return" = GT     | key2 == "Return" = LT     | orderHelper key1 l2 = LT@@ -122,7 +127,9 @@     | any (flip orderHelper l2) (flatten l1) = GT     | hasNoDeps l1 = LT     | hasNoDeps l2 = GT-    | otherwise = EQ -- FIXME transitive dependencies+    | key2 `elem` allDeps context key1 = LT+    | key1 `elem` allDeps context key2 = GT+    | otherwise = EQ  flatten :: [(Prob, [PreTok])] -> [Key] flatten = (>>= (fmap unTok . snd))

@@ -3,6 +3,10 @@     1.0 "two"     1.0 "three" +:define afifththing+    1.0 afourththing+    1.0 athirdthing+ :define afourththing     1.0 something     1.0 "fourth".oulipo@@ -18,4 +22,5 @@  :return     1.0 something+    1.0 afifththing     1.0 afourththing