madlang 2.4.2.4 → 2.4.2.5

raw patch · 5 files changed

+33/−8 lines, 5 filesdep +zip-archive

Dependencies added: zip-archive

Files

• cabal.project.local +1/−1
• madlang.cabal +2/−1
• src/Text/Madlibs/Ana/Resolve.hs +3/−1
• src/Text/Madlibs/Exec/Helpers.hs +21/−2
• src/Text/Madlibs/Exec/Main.hs +6/−3

@@ -1,3 +1,3 @@ with-compiler: ghc-8.2.1 optimization: 2-constraints: madlang +development +llvm-fast+constraints: madlang +development

@@ -1,5 +1,5 @@ name:                madlang-version:             2.4.2.4+version:             2.4.2.5 synopsis:            Randomized templating language DSL description:         Madlang is a text templating language written in Haskell,                      meant to explore computational creativity and generative@@ -76,6 +76,7 @@                      , http-client                      , tar                      , zlib+                     , zip-archive                      , recursion-schemes   default-language:    Haskell2010   if flag(development)

@@ -17,6 +17,7 @@ import           Data.Void import           System.Directory import           System.Environment+import           System.Info                 (os) import           Text.Madlibs.Ana.Parse import           Text.Madlibs.Ana.ParseUtils import           Text.Madlibs.Cata.Run@@ -34,7 +35,8 @@ -- | Generate text from file with inclusions getInclusionCtx :: Bool -> [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]) getInclusionCtx isTree ins folder filepath = do-    file <- catch (readFile' (folder ++ filepath)) (const (do { home <- getEnv "HOME" ; readFile' (home <> "/.madlang/" <> folder <> filepath) } ) :: IOException -> IO T.Text)+    libDir <- do { home <- getEnv "HOME" ; if os /= home then pure (home <> "/.madlang") else pure (home <> "\\.madlang") }+    file <- catch (readFile' (folder ++ filepath)) (const (readFile' (libDir <> folder <> filepath)) :: IOException -> IO T.Text)     let filenames = map T.unpack $ either (error . show) id $ parseInclusions filepath file -- TODO pass up errors correctly     let resolveKeys file' = fmap (first ((((T.pack . (<> "-")) . dropExtension) file') <>))     ctxPure <- mapM (getInclusionCtx isTree ins folder) filenames

@@ -1,12 +1,31 @@ {-# LANGUAGE OverloadedStrings #-} -module Text.Madlibs.Exec.Helpers (fetchPackages, cleanPackages) where+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.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+ -- TODO set remote package url flexibly fetchPackages :: IO () fetchPackages = do@@ -19,7 +38,7 @@      putStrLn "unpacking libraries..."     home <- getEnv "HOME"-    let packageDir = home ++ "/.madlang"+    let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"     Tar.unpack packageDir . Tar.read . decompress $ byteStringResponse  cleanPackages :: IO ()

@@ -18,13 +18,14 @@ import           Text.Megaparsec  -- | datatype for the program-data Program = Program { sub :: Subcommand }+newtype Program = Program { sub :: Subcommand }  -- | datatype for the subcommands data Subcommand = Debug { input :: FilePath }                 | Run { _rep :: Maybe Int , clInputs :: [String] , input :: FilePath }                 | Lint { clInputs :: [String] , input :: FilePath }                 | Install+                | VimInstall  -- | Parser for command-line options for the program orders :: Parser Program@@ -34,6 +35,7 @@         <> command "debug" (info debug (progDesc "Debug a template"))         <> command "lint" (info lint (progDesc "Lint a file"))         <> command "install" (info (pure Install) (progDesc "Install/update prebundled libraries."))+        <> command "vim" (info (pure VimInstall) (progDesc "Install vim plugin."))         ))  -- | Parser for the run subcommand@@ -93,16 +95,17 @@  -- | given a parsed record perform the appropriate IO action template :: Program -> IO ()-template rec = do+template rec =     case sub rec of         Install -> fetchPackages >> cleanPackages+        VimInstall -> installVimPlugin         _ -> do             let toFolder = input . sub $ rec             if getDir toFolder == "" then pure () else setCurrentDirectory (getDir toFolder)             let filepath = reverse . (takeWhile (/='/')) . reverse $ toFolder             let ins = map T.pack (clInputs . sub $ rec)             case sub rec of-                (Run reps _ _) -> do+                (Run reps _ _) ->                     replicateM_ (fromMaybe 1 reps) $ runFile ins filepath >>= TIO.putStrLn                 (Debug _) -> putStr . (either show displayTree) =<< makeTree ins "" filepath                 (Lint _ _) -> do