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

-- | Create a 'Optparse.Parser' from a list of source results and an option
-- parser. The source results are folded using '<|>' and then used as a single
-- result.
mkOptparseParser ::
  forall f a.
  ( Applicative f,
    B.TraversableB a,
    B.ApplicativeB a
  ) =>
  -- | Source results
  [a (Compose Maybe f)] ->
  -- | Target configuration options
  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

-- | Create a 'Optparse.Parser' for a single option, using the accumulated
-- source results.
mkParser ::
  -- | Accumulated source results
  Compose Maybe f a ->
  -- | Target option
  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

-- | Create a 'Optparse.Parser' for an 'OptionOpt', which results in an
-- @optparse-applicative@ 'Optparse.option'.
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)
          ]
      )

-- | Create a 'Optparse.Parser' for a 'FlagOpt', which results in an
-- @optparse-applicative@ 'Optparse.flag'.
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
        ]

-- | Create a 'Optparse.Parser' for a 'ArgumentOpt', which results in an
-- @optparse-applicative@ 'Optparse.argument'.
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)
          ]
      )