madlang 4.0.2.7 → 4.0.2.8
raw patch · 11 files changed
+106/−105 lines, 11 filesdep ~base
Dependency ranges changed: base
Files
- app/Main.hs +7/−5
- app/Text/Madlibs/Packaging/Fetch.hs +80/−0
- cabal.project.local +1/−3
- madlang.cabal +10/−10
- src/Text/Madlibs.hs +0/−5
- src/Text/Madlibs/Ana/Parse.hs +1/−0
- src/Text/Madlibs/Ana/ParseUtils.hs +3/−2
- src/Text/Madlibs/Ana/Resolve.hs +1/−0
- src/Text/Madlibs/Generate/TH.hs +1/−0
- src/Text/Madlibs/Internal/Types.hs +2/−0
- src/Text/Madlibs/Packaging/Fetch.hs +0/−80
app/Main.hs view
@@ -3,15 +3,17 @@ main ) where import Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TLIO+import Data.Semigroup+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TLIO import Data.Version-import Options.Applicative hiding (ParseError)+import Options.Applicative hiding (ParseError) import Paths_madlang import System.Directory import Text.Madlibs-import Text.Megaparsec hiding (many)+import Text.Madlibs.Packaging.Fetch+import Text.Megaparsec hiding (many) -- | datatype for the program newtype Program = Program { sub :: Subcommand }
+ app/Text/Madlibs/Packaging/Fetch.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Madlibs.Packaging.Fetch ( fetchGithub+ , fetchPackages+ , cleanPackages+ , installVimPlugin+ ) where++import qualified Codec.Archive.Tar as Tar+import Codec.Archive.Zip (ZipOption (..),+ extractFilesFromArchive, toArchive)+import Codec.Compression.GZip (decompress)+import Control.Monad (unless)+import Network.HTTP.Client hiding (decompress)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import System.Directory (removeFile, renameDirectory)+import System.Environment (getEnv)+import System.Info (os)++-- https://hub.darcs.net/vmchale/madlang-libraries/dist++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 <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager++ putStrLn "unpacking libraries..."+ home <- getEnv "HOME"+ let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"+ let options = OptDestination packageDir+ extractFilesFromArchive [options] (toArchive response)++ 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 <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager++ putStrLn "installing locally..."+ home <- getEnv "HOME"+ let packageDir = if os /= "mingw32" then home ++ "/.vim" else home ++ "\\vimfiles"+ let options = OptDestination packageDir+ extractFilesFromArchive [options] (toArchive response)++ 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 <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager++ putStrLn "unpacking libraries..."+ home <- getEnv "HOME"+ let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"+ Tar.unpack packageDir . Tar.read . decompress $ response++cleanPackages :: IO ()+cleanPackages =+ putStrLn "done."
cabal.project.local view
@@ -1,4 +1,2 @@-tests: true-benchmarks: true-documentation: true constraints: madlang +development+max-backjumps: 120000
madlang.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: madlang-version: 4.0.2.7+version: 4.0.2.8 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2016-2018 Vanessa McHale@@ -58,11 +58,10 @@ Text.Madlibs.Internal.Utils Text.Madlibs.Cata.SemErr Text.Madlibs.Cata.Display- Text.Madlibs.Packaging.Fetch default-language: Haskell2010 ghc-options: -Wall build-depends:- base >=4.11 && <5,+ base >=4.9 && <5, megaparsec >=6.0, text -any, template-haskell -any,@@ -76,11 +75,6 @@ containers -any, titlecase >=1.0, th-lift-instances -any,- http-client -any,- http-client-tls -any,- tar -any,- zlib -any,- zip-archive -any, recursion-schemes -any, binary -any @@ -95,15 +89,21 @@ hs-source-dirs: app other-modules: Paths_madlang+ Text.Madlibs.Packaging.Fetch default-language: Haskell2010 ghc-options: -Wall build-depends:- base >=4.11,+ base >=4.9, madlang -any, optparse-applicative -any, text -any, directory -any,- megaparsec -any+ megaparsec -any,+ http-client -any,+ tar -any,+ zlib -any,+ zip-archive -any,+ http-client-tls -any if flag(library) buildable: False
src/Text/Madlibs.hs view
@@ -40,10 +40,6 @@ , runFileN , getDir , displayTree- , fetchPackages- , cleanPackages- , fetchGithub- , installVimPlugin -- * Template Haskell EDSL , madlang , madFile@@ -57,4 +53,3 @@ import Text.Madlibs.Generate.TH import Text.Madlibs.Internal.Types import Text.Madlibs.Internal.Utils-import Text.Madlibs.Packaging.Fetch
src/Text/Madlibs/Ana/Parse.hs view
@@ -17,6 +17,7 @@ import Control.Monad.State import qualified Data.Map as M import Data.Maybe+import Data.Semigroup import qualified Data.Text as T import Data.Void import Text.Madlibs.Ana.ParseUtils
src/Text/Madlibs/Ana/ParseUtils.hs view
@@ -18,7 +18,8 @@ import Data.Foldable import Data.List import qualified Data.Map as M-import Data.Maybe (catMaybes)+import Data.Maybe (mapMaybe)+import Data.Semigroup import qualified Data.Set as S import qualified Data.Text as T import Data.Text.Titlecase@@ -108,7 +109,7 @@ maybeList Nothing = [] allDeps :: M.Map Key [(Prob, [PreTok])] -> Key -> S.Set Key-allDeps context key = let deps = (maybeList . fmap (catMaybes . fmap maybeName) . getNames) context in S.fromList (deps <> (S.toList . allDeps context =<< deps))+allDeps context key = let deps = (maybeList . fmap (mapMaybe maybeName) . getNames) context in S.fromList (deps <> (S.toList . allDeps context =<< deps)) where getNames = fmap ((=<<) snd) . M.lookup key maybeName (Name n _) = Just n maybeName _ = Nothing
src/Text/Madlibs/Ana/Resolve.hs view
@@ -18,6 +18,7 @@ import Control.Monad (replicateM, void) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Random.Class+import Data.Semigroup import qualified Data.Text as T import Data.Void import System.Directory
src/Text/Madlibs/Generate/TH.hs view
@@ -12,6 +12,7 @@ import Control.Arrow (first) import Data.FileEmbed (embedStringFile)+import Data.Semigroup import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Void
src/Text/Madlibs/Internal/Types.hs view
@@ -18,6 +18,7 @@ import Data.Binary (Binary) import Data.Function import Data.Functor.Foldable.TH (makeBaseFunctor)+import Data.Semigroup import qualified Data.Text as T import GHC.Generics (Generic) import Instances.TH.Lift ()@@ -61,6 +62,7 @@ -- > (List [(0.5,"Hello you"), (0.5, "Hello me")]) instance Monoid RandTok where mempty = Value ""+ mappend = (<>) -- TODO make this a map instead of keys for faster parse. -- | State monad providing context, i.e. function we've already called before
− src/Text/Madlibs/Packaging/Fetch.hs
@@ -1,80 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Text.Madlibs.Packaging.Fetch ( fetchGithub- , fetchPackages- , cleanPackages- , installVimPlugin- ) where--import qualified Codec.Archive.Tar as Tar-import Codec.Archive.Zip (ZipOption (..),- extractFilesFromArchive, toArchive)-import Codec.Compression.GZip (decompress)-import Control.Monad (unless)-import Network.HTTP.Client hiding (decompress)-import Network.HTTP.Client.TLS (tlsManagerSettings)-import System.Directory (removeFile, renameDirectory)-import System.Environment (getEnv)-import System.Info (os)---- https://hub.darcs.net/vmchale/madlang-libraries/dist--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 <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager-- putStrLn "unpacking libraries..."- home <- getEnv "HOME"- let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"- let options = OptDestination packageDir- extractFilesFromArchive [options] (toArchive response)-- 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 <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager-- putStrLn "installing locally..."- home <- getEnv "HOME"- let packageDir = if os /= "mingw32" then home ++ "/.vim" else home ++ "\\vimfiles"- let options = OptDestination packageDir- extractFilesFromArchive [options] (toArchive response)-- 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 <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager-- putStrLn "unpacking libraries..."- home <- getEnv "HOME"- let packageDir = if os /= "mingw32" then home ++ "/.madlang" else home ++ "\\.madlang"- Tar.unpack packageDir . Tar.read . decompress $ response--cleanPackages :: IO ()-cleanPackages =- putStrLn "done."