madlang 3.1.0.1 → 3.1.0.2
raw patch · 6 files changed
+101/−59 lines, 6 filesdep +http-client-tlsPVP ok
version bump matches the API change (PVP)
Dependencies added: http-client-tls
API changes (from Hackage documentation)
Files
- madlang.cabal +3/−2
- man/madlang.1 +4/−2
- src/Text/Madlibs/Ana/ParseUtils.hs +1/−1
- src/Text/Madlibs/Exec/Helpers.hs +0/−53
- src/Text/Madlibs/Exec/Main.hs +10/−1
- src/Text/Madlibs/Packaging/Fetch.hs +83/−0
madlang.cabal view
@@ -1,5 +1,5 @@ name: madlang-version: 3.1.0.1+version: 3.1.0.2 synopsis: Randomized templating language DSL description: Madlang is a text templating language written in Haskell, meant to explore computational creativity and generative@@ -56,7 +56,7 @@ , Text.Madlibs.Cata.SemErr , Text.Madlibs.Cata.Display , Text.Madlibs.Exec.Main- , Text.Madlibs.Exec.Helpers+ , Text.Madlibs.Packaging.Fetch , Paths_madlang build-depends: base >= 4.8 && < 5 , megaparsec >= 6.0@@ -74,6 +74,7 @@ , titlecase , th-lift-instances , http-client+ , http-client-tls , tar , zlib , zip-archive
man/madlang.1 view
@@ -9,9 +9,11 @@ .PP madlang run <file> .PP-madlang debug <file>+madlang tree <file> .PP-madlang lint <file>+madlang check <file>+.PP+madlang get <repo> .SH DESCRIPTION .PP \f[B]madlang\f[] is an interpreted language for generative literature
src/Text/Madlibs/Ana/ParseUtils.hs view
@@ -113,7 +113,7 @@ maybeList Nothing = [] allDeps :: [(Key, [(Prob, [PreTok])])] -> Key -> [Key]-allDeps context key = let deps = (maybeList . fmap (catMaybes . (fmap maybeName)) . getNames) context in deps <> (allDeps context =<< deps)+allDeps context key = let deps = (maybeList . fmap (catMaybes . fmap maybeName) . getNames) context in deps <> (allDeps context =<< deps) where getNames = fmap ((=<<) snd) . lookup key maybeName (Name n _) = Just n maybeName _ = Nothing
− src/Text/Madlibs/Exec/Helpers.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Text.Madlibs.Exec.Helpers (fetchPackages, cleanPackages, installVimPlugin) where--import qualified Codec.Archive.Tar as Tar-import Codec.Archive.Zip (ZipOption (..),- extractFilesFromArchive, toArchive)-import Codec.Compression.GZip (decompress)-import Network.HTTP.Client hiding (decompress)-import System.Directory (removeFile)-import System.Environment (getEnv)-import System.Info (os)--installVimPlugin :: IO ()-installVimPlugin = do-- putStrLn "fetching latest vim plugin..."- manager <- newManager defaultManagerSettings- initialRequest <- parseRequest "http://vmchale.com/static/vim.zip"- response <- httpLbs (initialRequest { method = "GET" }) manager- let byteStringResponse = responseBody response-- putStrLn "installing locally..."- home <- getEnv "HOME"- let packageDir = if os /= "mingw32" then home ++ "/.vim" else home ++ "\\vimfiles"- let archive = toArchive byteStringResponse- let options = OptDestination packageDir- extractFilesFromArchive [options] archive-- putStrLn "cleaning junk..."- removeFile (packageDir ++ "/TODO.md")- removeFile (packageDir ++ "/vim-screenshot.png")- removeFile (packageDir ++ "/README.md")- removeFile (packageDir ++ "/LICENSE")---- TODO set remote package url flexibly-fetchPackages :: IO ()-fetchPackages = do-- putStrLn "fetching libraries..."- manager <- newManager defaultManagerSettings- initialRequest <- parseRequest "http://vmchale.com/static/packages.tar.gz"- response <- httpLbs (initialRequest { method = "GET" }) manager- let byteStringResponse = responseBody response-- putStrLn "unpacking libraries..."- home <- getEnv "HOME"- let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"- Tar.unpack packageDir . Tar.read . decompress $ byteStringResponse--cleanPackages :: IO ()-cleanPackages =- putStrLn "done."
src/Text/Madlibs/Exec/Main.hs view
@@ -13,7 +13,7 @@ import System.Directory import Text.Madlibs.Ana.Resolve import Text.Madlibs.Cata.Display-import Text.Madlibs.Exec.Helpers+import Text.Madlibs.Packaging.Fetch import Text.Madlibs.Internal.Utils import Text.Megaparsec @@ -25,6 +25,7 @@ | Run { _rep :: Maybe Int , clInputs :: [String] , input :: FilePath } | Lint { clInputs :: [String] , input :: FilePath } | Sample { clInputs :: [String], input :: FilePath }+ | Get { _remote :: String } | Install | VimInstall @@ -37,6 +38,7 @@ <> command "check" (info lint (progDesc "Check a file")) <> command "sample" (info sample (progDesc "Sample a template by generating text many times.")) <> command "install" (info (pure Install) (progDesc "Install/update prebundled libraries."))+ <> command "get" (info fetch (progDesc "Sample a template by generating text many times.")) <> command "vim" (info (pure VimInstall) (progDesc "Install vim plugin.")) )) @@ -69,6 +71,12 @@ <> completer (bashCompleter "file -X '!*.mad' -o plusdirs") <> help "File path to madlang template")) +fetch :: Parser Subcommand+fetch = Get+ <$> (argument str+ (metavar "REPOSITORY"+ <> help "Repository to fetch, e.g. vmchale/some-library"))+ debug :: Parser Subcommand debug = Debug <$> (argument str@@ -113,6 +121,7 @@ case sub rec of Install -> fetchPackages >> cleanPackages VimInstall -> installVimPlugin+ Get remote -> fetchGithub remote _ -> do let toFolder = input . sub $ rec if getDir toFolder == "" then pure () else setCurrentDirectory (getDir toFolder)
+ src/Text/Madlibs/Packaging/Fetch.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Madlibs.Packaging.Fetch ( fetchGithub+ , fetchPackages+ , cleanPackages+ , installVimPlugin+ ) where++import Control.Monad (unless)+import qualified Codec.Archive.Tar as Tar+import Codec.Archive.Zip (ZipOption (..),+ extractFilesFromArchive, toArchive)+import Codec.Compression.GZip (decompress)+import Network.HTTP.Client hiding (decompress)+import System.Directory (removeFile, renameDirectory)+import System.Environment (getEnv)+import System.Info (os)+import Network.HTTP.Client.TLS (tlsManagerSettings)++invalid :: String -> Bool+invalid = not . ('/' `elem`)++-- | As an example, `vmchale/some-library` would be valid input.+fetchGithub :: String -> IO ()+fetchGithub s = unless (invalid s) $ do++ putStrLn $ "fetching library at " ++ s+ + manager <- newManager tlsManagerSettings+ initialRequest <- parseRequest $ "https://github.com/" ++ s ++ "/archive/master.zip"+ response <- httpLbs (initialRequest { method = "GET" }) manager+ let byteStringResponse = responseBody response++ putStrLn "unpacking libraries..."+ home <- getEnv "HOME"+ let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"+ let archive = toArchive byteStringResponse+ let options = OptDestination packageDir+ extractFilesFromArchive [options] archive++ let repoName = filter (/='/') . dropWhile (/='/') $ s+ renameDirectory (packageDir ++ "/" ++ repoName ++ "-master") (packageDir ++ "/" ++ repoName)++installVimPlugin :: IO ()+installVimPlugin = do++ putStrLn "fetching latest vim plugin..."+ manager <- newManager defaultManagerSettings+ initialRequest <- parseRequest "http://vmchale.com/static/vim.zip"+ response <- httpLbs (initialRequest { method = "GET" }) manager+ let byteStringResponse = responseBody response++ putStrLn "installing locally..."+ home <- getEnv "HOME"+ let packageDir = if os /= "mingw32" then home ++ "/.vim" else home ++ "\\vimfiles"+ let archive = toArchive byteStringResponse+ let options = OptDestination packageDir+ extractFilesFromArchive [options] archive++ putStrLn "cleaning junk..."+ removeFile (packageDir ++ "/TODO.md")+ removeFile (packageDir ++ "/vim-screenshot.png")+ removeFile (packageDir ++ "/README.md")+ removeFile (packageDir ++ "/LICENSE")++-- TODO set remote package url flexibly+fetchPackages :: IO ()+fetchPackages = do++ putStrLn "fetching libraries..."+ manager <- newManager defaultManagerSettings+ initialRequest <- parseRequest "http://vmchale.com/static/packages.tar.gz"+ response <- httpLbs (initialRequest { method = "GET" }) manager+ let byteStringResponse = responseBody response++ putStrLn "unpacking libraries..."+ home <- getEnv "HOME"+ let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"+ Tar.unpack packageDir . Tar.read . decompress $ byteStringResponse++cleanPackages :: IO ()+cleanPackages =+ putStrLn "done."