module Options.Harg.Cmdline
( mkOptparseParser,
)
where
import qualified Barbies as B
import Control.Applicative ((<|>))
import Data.Functor.Compose (Compose (..))
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import qualified Options.Applicative as Optparse
import Options.Harg.Pretty (ppHelp)
import Options.Harg.Types
mkOptparseParser ::
forall f a.
( Applicative f,
B.TraversableB a,
B.ApplicativeB a
) =>
[a (Compose Maybe f)] ->
a (Compose Opt f) ->
Optparse.Parser (a f)
mkOptparseParser :: [a (Compose Maybe f)] -> a (Compose Opt f) -> Parser (a f)
mkOptparseParser sources :: [a (Compose Maybe f)]
sources opts :: a (Compose Opt f)
opts =
a (Compose Parser f) -> Parser (a f)
forall k (e :: * -> *) (b :: (k -> *) -> *) (f :: k -> *).
(Applicative e, TraversableB b) =>
b (Compose e f) -> e (b f)
B.bsequence (a (Compose Parser f) -> Parser (a f))
-> a (Compose Parser f) -> Parser (a f)
forall a b. (a -> b) -> a -> b
$ (forall a.
Compose Maybe f a -> Compose Opt f a -> Compose Parser f a)
-> a (Compose Maybe f) -> a (Compose Opt f) -> a (Compose Parser f)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
(h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
B.bzipWith forall a.
Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
forall (f :: * -> *) a.
Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
mkParser a (Compose Maybe f)
srcOpts a (Compose Opt f)
opts
where
srcOpts :: a (Compose Maybe f)
srcOpts =
(a (Compose Maybe f) -> a (Compose Maybe f) -> a (Compose Maybe f))
-> a (Compose Maybe f)
-> [a (Compose Maybe f)]
-> a (Compose Maybe f)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
((forall a.
Compose Maybe f a -> Compose Maybe f a -> Compose Maybe f a)
-> a (Compose Maybe f)
-> a (Compose Maybe f)
-> a (Compose Maybe f)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
(h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
B.bzipWith forall a.
Compose Maybe f a -> Compose Maybe f a -> Compose Maybe f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>))
((forall a. Compose Opt f a -> Compose Maybe f a)
-> a (Compose Opt f) -> a (Compose Maybe f)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
B.bmap (Compose Maybe f a -> Compose Opt f a -> Compose Maybe f a
forall a b. a -> b -> a
const (Maybe (f a) -> Compose Maybe f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (f a)
forall a. Maybe a
Nothing)) a (Compose Opt f)
opts)
[a (Compose Maybe f)]
sources
mkParser ::
Compose Maybe f a ->
Compose Opt f a ->
Compose Optparse.Parser f a
mkParser :: Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
mkParser srcs :: Compose Maybe f a
srcs opt :: Compose Opt f a
opt@(Compose Opt {..}) =
case OptType (f a)
_optType of
OptionOptType -> Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
forall (f :: * -> *) a.
Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
toOptionParser Compose Maybe f a
srcs Compose Opt f a
opt
FlagOptType active :: f a
active -> Compose Maybe f a -> Compose Opt f a -> f a -> Compose Parser f a
forall (f :: * -> *) a.
Compose Maybe f a -> Compose Opt f a -> f a -> Compose Parser f a
toFlagParser Compose Maybe f a
srcs Compose Opt f a
opt f a
active
ArgumentOptType -> Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
forall (f :: * -> *) a.
Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
toArgumentParser Compose Maybe f a
srcs Compose Opt f a
opt
toOptionParser ::
Compose Maybe f a ->
Compose Opt f a ->
Compose Optparse.Parser f a
toOptionParser :: Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
toOptionParser sources :: Compose Maybe f a
sources (Compose opt :: Opt (f a)
opt@Opt {..}) =
Parser (f a) -> Compose Parser f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Parser (f a) -> Compose Parser f a)
-> Parser (f a) -> Compose Parser f a
forall a b. (a -> b) -> a -> b
$
ReadM (f a) -> Mod OptionFields (f a) -> Parser (f a)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Optparse.option
(OptReader (f a) -> ReadM (f a)
forall a. (String -> Either String a) -> ReadM a
Optparse.eitherReader OptReader (f a)
_optReader)
( (Maybe (Mod OptionFields (f a)) -> Mod OptionFields (f a))
-> [Maybe (Mod OptionFields (f a))] -> Mod OptionFields (f a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(Mod OptionFields (f a)
-> Maybe (Mod OptionFields (f a)) -> Mod OptionFields (f a)
forall a. a -> Maybe a -> a
fromMaybe Mod OptionFields (f a)
forall a. Monoid a => a
mempty)
[ String -> Mod OptionFields (f a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long (String -> Mod OptionFields (f a))
-> Maybe String -> Maybe (Mod OptionFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_optLong,
Char -> Mod OptionFields (f a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Optparse.short (Char -> Mod OptionFields (f a))
-> Maybe Char -> Maybe (Mod OptionFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
_optShort,
String -> Mod OptionFields (f a)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help (String -> Mod OptionFields (f a))
-> Maybe String -> Maybe (Mod OptionFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt (f a) -> Maybe String
forall a. Opt a -> Maybe String
ppHelp Opt (f a)
opt,
String -> Mod OptionFields (f a)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar (String -> Mod OptionFields (f a))
-> Maybe String -> Maybe (Mod OptionFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_optMetavar,
f a -> Mod OptionFields (f a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Optparse.value (f a -> Mod OptionFields (f a))
-> Maybe (f a) -> Maybe (Mod OptionFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Compose Maybe f a -> Maybe (f a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose Compose Maybe f a
sources Maybe (f a) -> Maybe (f a) -> Maybe (f a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (f a)
_optDefaultVal)
]
)
toFlagParser ::
Compose Maybe f a ->
Compose Opt f a ->
f a ->
Compose Optparse.Parser f a
toFlagParser :: Compose Maybe f a -> Compose Opt f a -> f a -> Compose Parser f a
toFlagParser sources :: Compose Maybe f a
sources (Compose opt :: Opt (f a)
opt@Opt {..}) active :: f a
active =
Parser (f a) -> Compose Parser f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Parser (f a) -> Compose Parser f a)
-> Parser (f a) -> Compose Parser f a
forall a b. (a -> b) -> a -> b
$
case Maybe (f a)
mDef of
Nothing ->
f a -> Mod FlagFields (f a) -> Parser (f a)
forall a. a -> Mod FlagFields a -> Parser a
Optparse.flag' f a
active Mod FlagFields (f a)
modifiers
Just def :: f a
def ->
f a -> f a -> Mod FlagFields (f a) -> Parser (f a)
forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag f a
def f a
active Mod FlagFields (f a)
modifiers
where
mDef :: Maybe (f a)
mDef =
Compose Maybe f a -> Maybe (f a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose Compose Maybe f a
sources Maybe (f a) -> Maybe (f a) -> Maybe (f a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (f a)
_optDefaultVal
modifiers :: Mod FlagFields (f a)
modifiers =
(Maybe (Mod FlagFields (f a)) -> Mod FlagFields (f a))
-> [Maybe (Mod FlagFields (f a))] -> Mod FlagFields (f a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(Mod FlagFields (f a)
-> Maybe (Mod FlagFields (f a)) -> Mod FlagFields (f a)
forall a. a -> Maybe a -> a
fromMaybe Mod FlagFields (f a)
forall a. Monoid a => a
mempty)
[ String -> Mod FlagFields (f a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long (String -> Mod FlagFields (f a))
-> Maybe String -> Maybe (Mod FlagFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_optLong,
Char -> Mod FlagFields (f a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Optparse.short (Char -> Mod FlagFields (f a))
-> Maybe Char -> Maybe (Mod FlagFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
_optShort,
String -> Mod FlagFields (f a)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help (String -> Mod FlagFields (f a))
-> Maybe String -> Maybe (Mod FlagFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt (f a) -> Maybe String
forall a. Opt a -> Maybe String
ppHelp Opt (f a)
opt
]
toArgumentParser ::
Compose Maybe f a ->
Compose Opt f a ->
Compose Optparse.Parser f a
toArgumentParser :: Compose Maybe f a -> Compose Opt f a -> Compose Parser f a
toArgumentParser sources :: Compose Maybe f a
sources (Compose opt :: Opt (f a)
opt@Opt {..}) =
Parser (f a) -> Compose Parser f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Parser (f a) -> Compose Parser f a)
-> Parser (f a) -> Compose Parser f a
forall a b. (a -> b) -> a -> b
$
ReadM (f a) -> Mod ArgumentFields (f a) -> Parser (f a)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Optparse.argument
(OptReader (f a) -> ReadM (f a)
forall a. (String -> Either String a) -> ReadM a
Optparse.eitherReader OptReader (f a)
_optReader)
( (Maybe (Mod ArgumentFields (f a)) -> Mod ArgumentFields (f a))
-> [Maybe (Mod ArgumentFields (f a))] -> Mod ArgumentFields (f a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(Mod ArgumentFields (f a)
-> Maybe (Mod ArgumentFields (f a)) -> Mod ArgumentFields (f a)
forall a. a -> Maybe a -> a
fromMaybe Mod ArgumentFields (f a)
forall a. Monoid a => a
mempty)
[ String -> Mod ArgumentFields (f a)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help (String -> Mod ArgumentFields (f a))
-> Maybe String -> Maybe (Mod ArgumentFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt (f a) -> Maybe String
forall a. Opt a -> Maybe String
ppHelp Opt (f a)
opt,
String -> Mod ArgumentFields (f a)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar (String -> Mod ArgumentFields (f a))
-> Maybe String -> Maybe (Mod ArgumentFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_optMetavar,
f a -> Mod ArgumentFields (f a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Optparse.value (f a -> Mod ArgumentFields (f a))
-> Maybe (f a) -> Maybe (Mod ArgumentFields (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Compose Maybe f a -> Maybe (f a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose Compose Maybe f a
sources Maybe (f a) -> Maybe (f a) -> Maybe (f a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (f a)
_optDefaultVal)
]
)