{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Trial helper functions for @optparse-applicative@.
-}

module Trial.OptparseApplicative
       ( trialParser
       , taggedTrialParser
       , trialOption
       , taggedTrialOption
       ) where

import Data.String (IsString (..))
import Options.Applicative (Parser, ReadM, long, option, optional)
import Trial (TaggedTrial, Trial, maybeToTrial, withTag)


{- | 'Parser' for 'Trial' data structure.
It uses the provided name for better 'Trial.Warning's and
'Trial.Error's.

@since 0.0.0.0
-}
trialParser
    :: (Semigroup e, IsString e)
    => String  -- ^ Name
    -> Parser a
    -> Parser (Trial e a)
trialParser :: String -> Parser a -> Parser (Trial e a)
trialParser field :: String
field parser :: Parser a
parser = String -> Maybe a -> Trial e a
forall e a.
(Semigroup e, IsString e) =>
String -> Maybe a -> Trial e a
mToTrial String
field (Maybe a -> Trial e a) -> Parser (Maybe a) -> Parser (Trial e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser a
parser

{- | Similar to 'trialParser' but returns 'TaggedTrial' with the tag @CLI@.

'Parser' for 'TaggedTrial' data structure.
It uses the providedname for better 'Trial.Warning's and
'Trial.Error's.

@since 0.0.0.0
-}
taggedTrialParser
    :: (Semigroup e, IsString e)
    => String  -- ^ Option name
    -> Parser a
    -> Parser (TaggedTrial e a)
taggedTrialParser :: String -> Parser a -> Parser (TaggedTrial e a)
taggedTrialParser field :: String
field parser :: Parser a
parser = String -> Maybe a -> TaggedTrial e a
forall e a.
(Semigroup e, IsString e) =>
String -> Maybe a -> TaggedTrial e a
mToTaggedTrial String
field (Maybe a -> TaggedTrial e a)
-> Parser (Maybe a) -> Parser (TaggedTrial e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser a
parser

{- | 'Parser' for 'Trial' data structure.
It uses the provided option 'long' name for better 'Trial.Warning's and
'Trial.Error's.

@since 0.0.0.0
-}
trialOption
    :: (Semigroup e, IsString e)
    => String  -- ^ Option 'long' name
    -> ReadM a
    -> Parser (Trial e a)
trialOption :: String -> ReadM a -> Parser (Trial e a)
trialOption field :: String
field opt :: ReadM a
opt = String -> Maybe a -> Trial e a
forall e a.
(Semigroup e, IsString e) =>
String -> Maybe a -> Trial e a
mToTrial String
field (Maybe a -> Trial e a) -> Parser (Maybe a) -> Parser (Trial e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
opt (String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
field))

{- | Similar to 'trialOption' but returns 'TaggedTrial'  with the tag @CLI@.

'Parser' for 'TaggedTrial' data structure.
It uses the provided option 'long' name for better 'Trial.Warning's and
'Trial.Error's.

@since 0.0.0.0
-}
taggedTrialOption
    :: (Semigroup e, IsString e)
    => String  -- ^ Option 'long' name
    -> ReadM a
    -> Parser (TaggedTrial e a)
taggedTrialOption :: String -> ReadM a -> Parser (TaggedTrial e a)
taggedTrialOption field :: String
field opt :: ReadM a
opt = String -> Maybe a -> TaggedTrial e a
forall e a.
(Semigroup e, IsString e) =>
String -> Maybe a -> TaggedTrial e a
mToTaggedTrial String
field (Maybe a -> TaggedTrial e a)
-> Parser (Maybe a) -> Parser (TaggedTrial e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
opt (String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
field))


mToTaggedTrial :: (Semigroup e, IsString e) => String -> Maybe a -> TaggedTrial e a
mToTaggedTrial :: String -> Maybe a -> TaggedTrial e a
mToTaggedTrial field :: String
field = e -> Trial e a -> TaggedTrial e a
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "CLI" (Trial e a -> TaggedTrial e a)
-> (Maybe a -> Trial e a) -> Maybe a -> TaggedTrial e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a -> Trial e a
forall e a.
(Semigroup e, IsString e) =>
String -> Maybe a -> Trial e a
mToTrial String
field

mToTrial :: (Semigroup e, IsString e) => String -> Maybe a -> Trial e a
mToTrial :: String -> Maybe a -> Trial e a
mToTrial field :: String
field = e -> Maybe a -> Trial e a
forall e a. e -> Maybe a -> Trial e a
maybeToTrial ("No CLI option specified for " e -> e -> e
forall a. Semigroup a => a -> a -> a
<> String -> e
forall a. IsString a => String -> a
fromString String
field)