servant-cli 0.1.0.0 → 0.1.0.1
raw patch · 3 files changed
+44/−33 lines, 3 filesdep +functor-combinatorsdep +transformersdep −kan-extensionsdep ~base
Dependencies added: functor-combinators, transformers
Dependencies removed: kan-extensions
Dependency ranges changed: base
Files
- CHANGELOG.md +9/−0
- servant-cli.cabal +7/−5
- src/Servant/CLI/Internal/PStruct.hs +28/−28
CHANGELOG.md view
@@ -1,6 +1,15 @@ Changelog ========= +Version 0.1.0.1+---------------++*June 19, 2019*++<https://github.com/mstksg/servant-cli/releases/tag/v0.1.0.1>++* Minor rewrite to use *functor-combinators* under the hood.+ Version 0.1.0.0 ---------------
servant-cli.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 85f3cb39849fe82dcb28a8a8da108c99ffb6de9a912b6acd59c5a6a8ccf8793a+-- hash: cc77d286e5084052ae5e3a6a33247742fcfc01d72b8da6244b83f5d4a57f8fbb name: servant-cli-version: 0.1.0.0+version: 0.1.0.1 synopsis: Command line interface for Servant API clients description: Parse command line arguments into a servant client, from a servant API, using /optparse-applicative/ for parsing, displaying help, and@@ -26,6 +26,7 @@ copyright: (c) Justin Le 2019 license: BSD3 license-file: LICENSE+tested-with: GHC >= 8.4 build-type: Simple extra-source-files: README.md@@ -47,14 +48,14 @@ src ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Werror=incomplete-patterns build-depends:- base >=4.7 && <5+ base >=4.11 && <5 , bytestring , case-insensitive , containers , filepath , free+ , functor-combinators , http-types- , kan-extensions , optparse-applicative , profunctors , recursion-schemes@@ -62,6 +63,7 @@ , servant-client-core >=0.15 , servant-docs , text+ , transformers , vinyl default-language: Haskell2010 @@ -74,7 +76,7 @@ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Werror=incomplete-patterns build-depends: aeson- , base >=4.7 && <5+ , base >=4.11 && <5 , bytestring , containers , http-client
src/Servant/CLI/Internal/PStruct.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-}@@ -42,19 +43,20 @@ , orRequired, orOptional, orSwitch ) where +import Control.Applicative.Backwards import Control.Applicative.Free import Data.Foldable import Data.Function import Data.Functor-import Data.Functor.Coyoneda-import Data.Functor.Day+import Data.Functor.Combinator+import Data.Functor.Combinator.Unsafe import Data.Functor.Foldable import Data.Functor.Foldable.TH import Data.Kind import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe-import GHC.Generics+import Data.Proxy import Options.Applicative import System.FilePath import qualified Data.Map as M@@ -108,7 +110,7 @@ :+: Day MultiArg EndpointMap -- | Endpoint arguments and body.-data Endpoint a = Endpoint+newtype Endpoint a = Endpoint { epStruct :: Day (Ap Opt) Parser a } deriving Functor @@ -126,11 +128,6 @@ makeBaseFunctor ''PStruct -(|+|) :: (f a -> r) -> (g a -> r) -> (f :+: g) a -> r-f |+| g = \case- L1 x -> f x- R1 y -> g y- -- | Convert a 'PStruct' into a command line argument parser, from the -- /optparse-applicative/ library. It can be run with 'execParser'. --@@ -169,9 +166,10 @@ | otherwise = subparser $ subs <> metavar "COMPONENT" <> commandGroup "Path components:"- (nsc, cap) = maybe ([], empty) (mkArg p |+| (([],) . mkArgs)) psCapturesF- ep = methodPicker psEndpointsF- ns = psInfoF ++ nsc+ cap = unsafePlus (Proxy @Parser) $+ interpret (mkArg p !*! mkArgs) $ MaybeF psCapturesF+ ep = methodPicker psEndpointsF+ ns = psInfoF mkHelp | toHelp = helper | otherwise = pure id@@ -181,21 +179,21 @@ -> (Bool -> [String] -> InfoMod x -> ParserInfo x) -> Mod CommandFields x mkCmd ps c p = command c (p True (ps ++ [c]) mempty)- mkArg :: [String] -> Day Arg PStruct x -> ([String], Parser x)+ mkArg :: [String] -> Day Arg PStruct x -> Parser x mkArg ps (Day a p f) =- ( []- , f <$> argParser a- <*> infoParser (structParser_ p False (ps ++ [':' : argName a]) mempty)- )+ f <$> argParser a+ <*> infoParser (structParser_ p False (ps ++ [':' : argName a]) mempty) mkArgs :: Day MultiArg EndpointMap x -> Parser x- mkArgs (Day (MultiArg a) ps f) =- flip f <$> methodPicker ps- <*> many (argParser a)+ mkArgs = upgradeC @Day (Proxy @Parser) $+ forwards+ . ( Backwards . (\case MultiArg a -> many (argParser a))+ !*! Backwards . methodPicker+ ) argParser :: Arg x -> Parser x argParser Arg{..} = argument argRead $ help argDesc <> metavar argMeta mkOpt :: Opt x -> Parser x- mkOpt Opt{..} = lowerCoyoneda $ (`hoistCoyoneda` optRead) $ \case+ mkOpt Opt{..} = forI optRead $ \case ORRequired r -> option r mods OROptional r -> optional $ option r mods ORSwitch -> switch $ long optName <> help optDesc@@ -217,7 +215,9 @@ where epMap = mkEndpoint <$> eps mkEndpoint :: Endpoint x -> Parser x- mkEndpoint = dap . trans1 (runAp mkOpt) . epStruct+ mkEndpoint = upgradeC @Day (Proxy @Parser) $+ binterpret (interpret mkOpt) id+ . epStruct pickMethod :: HTTP.Method -> Parser x -> Mod CommandFields x pickMethod m p = command (T.unpack . T.decodeUtf8 $ m) $ info (p <**> helper) mempty mkRaw :: Endpoint (HTTP.Method -> x) -> Parser x@@ -298,7 +298,7 @@ addEndpointOpt :: Opt a -> Endpoint (a -> b) -> Endpoint b addEndpointOpt o (Endpoint (Day eo eb ef)) =- Endpoint (Day ((,) <$> liftAp o <*> eo) eb $ \(x, y) z -> ef y z x)+ Endpoint (Day ((,) <$> inject o <*> eo) eb $ \(x, y) z -> ef y z x) addEPMOpt :: Opt a -> EndpointMap (a -> b) -> EndpointMap b addEPMOpt o (EPM e r) = EPM e' r'@@ -343,8 +343,8 @@ infixr 4 %:> addEndpointBody :: Parser a -> Endpoint (a -> b) -> Endpoint b-addEndpointBody b (Endpoint (Day eo eb ef)) =- Endpoint (Day eo (liftA2 (,) b eb) $ \x (y, z) -> ef x z y)+addEndpointBody b (Endpoint d) =+ Endpoint (inR b <**> d) addEPMBody :: Parser a -> EndpointMap (a -> b) -> EndpointMap b addEPMBody b (EPM e r) = EPM e' r'@@ -366,14 +366,14 @@ -- | Helper to lift a 'ReadM' into something that can be used with 'optRead'. orRequired :: ReadM a -> Coyoneda OptRead a-orRequired = liftCoyoneda . ORRequired+orRequired = inject . ORRequired -- | Helper to lift an optional 'ReadM' into something that can be used -- with 'optRead'. orOptional :: ReadM a -> Coyoneda OptRead (Maybe a)-orOptional = liftCoyoneda . OROptional+orOptional = inject . OROptional -- | An 'optRead' that is on-or-off. orSwitch :: Coyoneda OptRead Bool-orSwitch = liftCoyoneda ORSwitch+orSwitch = inject ORSwitch