{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}

module Options.Harg.Sources.DefaultStr
  ( DefaultStrSource (..),
  )
where

import qualified Barbies as B
import Data.Functor.Compose (Compose (..))
import Data.Kind (Type)
import GHC.Generics (Generic)
import Options.Harg.Sources.Types
import Options.Harg.Types

-- | Source that enables a parser to read options from defaults that are provided
-- as strings (unparsed).
data DefaultStrSource (f :: Type -> Type) = DefaultStrSource
  deriving ((forall x. DefaultStrSource f -> Rep (DefaultStrSource f) x)
-> (forall x. Rep (DefaultStrSource f) x -> DefaultStrSource f)
-> Generic (DefaultStrSource f)
forall x. Rep (DefaultStrSource f) x -> DefaultStrSource f
forall x. DefaultStrSource f -> Rep (DefaultStrSource f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (DefaultStrSource f) x -> DefaultStrSource f
forall (f :: * -> *) x.
DefaultStrSource f -> Rep (DefaultStrSource f) x
$cto :: forall (f :: * -> *) x.
Rep (DefaultStrSource f) x -> DefaultStrSource f
$cfrom :: forall (f :: * -> *) x.
DefaultStrSource f -> Rep (DefaultStrSource f) x
Generic, (forall (f :: * -> *) (g :: * -> *).
 (forall a. f a -> g a) -> DefaultStrSource f -> DefaultStrSource g)
-> FunctorB DefaultStrSource
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
 (forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> DefaultStrSource f -> DefaultStrSource g
bmap :: (forall a. f a -> g a) -> DefaultStrSource f -> DefaultStrSource g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> DefaultStrSource f -> DefaultStrSource g
B.FunctorB, FunctorB DefaultStrSource
FunctorB DefaultStrSource =>
(forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
 Applicative e =>
 (forall a. f a -> e (g a))
 -> DefaultStrSource f -> e (DefaultStrSource g))
-> TraversableB DefaultStrSource
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
 Applicative e =>
 (forall (a :: k). f a -> e (g a)) -> b f -> e (b g))
-> TraversableB b
forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> DefaultStrSource f -> e (DefaultStrSource g)
btraverse :: (forall a. f a -> e (g a))
-> DefaultStrSource f -> e (DefaultStrSource g)
$cbtraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> DefaultStrSource f -> e (DefaultStrSource g)
$cp1TraversableB :: FunctorB DefaultStrSource
B.TraversableB, FunctorB DefaultStrSource
FunctorB DefaultStrSource =>
(forall (f :: * -> *). (forall a. f a) -> DefaultStrSource f)
-> (forall (f :: * -> *) (g :: * -> *).
    DefaultStrSource f
    -> DefaultStrSource g -> DefaultStrSource (Product f g))
-> ApplicativeB DefaultStrSource
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (f :: k -> *). (forall (a :: k). f a) -> b f)
-> (forall (f :: k -> *) (g :: k -> *).
    b f -> b g -> b (Product f g))
-> ApplicativeB b
forall (f :: * -> *). (forall a. f a) -> DefaultStrSource f
forall (f :: * -> *) (g :: * -> *).
DefaultStrSource f
-> DefaultStrSource g -> DefaultStrSource (Product f g)
bprod :: DefaultStrSource f
-> DefaultStrSource g -> DefaultStrSource (Product f g)
$cbprod :: forall (f :: * -> *) (g :: * -> *).
DefaultStrSource f
-> DefaultStrSource g -> DefaultStrSource (Product f g)
bpure :: (forall a. f a) -> DefaultStrSource f
$cbpure :: forall (f :: * -> *). (forall a. f a) -> DefaultStrSource f
$cp1ApplicativeB :: FunctorB DefaultStrSource
B.ApplicativeB)

-- | Value of 'DefaultStrSource' is a dummy value, as the default string option can
-- be found inside the 'Opt' ('_optDefaultStr').
data DefaultStrSourceVal = DefaultStrSourceVal

instance GetSource DefaultStrSource f where
  type SourceVal DefaultStrSource = DefaultStrSourceVal
  getSource :: HargCtx -> DefaultStrSource f -> IO (SourceVal DefaultStrSource)
getSource HargCtx {..} _ =
    DefaultStrSourceVal -> IO DefaultStrSourceVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultStrSourceVal
DefaultStrSourceVal

instance
  ( B.FunctorB a,
    B.TraversableB a
  ) =>
  RunSource DefaultStrSourceVal a
  where
  runSource :: DefaultStrSourceVal
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource DefaultStrSourceVal opt :: a (Compose Opt f)
opt =
    [a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall (a :: (* -> *) -> *) (f :: * -> *).
(FunctorB a, TraversableB a, Applicative f) =>
a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runDefaultStrSource a (Compose Opt f)
opt]

-- TODO: this looks very similar to EnvSource, perhaps unify
runDefaultStrSource ::
  forall a f.
  ( B.FunctorB a,
    B.TraversableB a,
    Applicative f
  ) =>
  a (Compose Opt f) ->
  Either SourceRunError (a (Compose SourceRunResult f))
runDefaultStrSource :: a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runDefaultStrSource =
  (forall a.
 Compose Opt f a
 -> Either SourceRunError (Compose SourceRunResult f a))
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
B.btraverse forall a.
Compose Opt f a
-> Either SourceRunError (Compose SourceRunResult f a)
go
  where
    go ::
      Compose Opt f x ->
      Either SourceRunError (Compose SourceRunResult f x)
    go :: Compose Opt f x
-> Either SourceRunError (Compose SourceRunResult f x)
go (Compose opt :: Opt (f x)
opt@Opt {..}) =
      Either SourceRunError (Compose SourceRunResult f x)
-> (String -> Either SourceRunError (Compose SourceRunResult f x))
-> Maybe String
-> Either SourceRunError (Compose SourceRunResult f x)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either SourceRunError (Compose SourceRunResult f x)
forall a a. Either a (Compose SourceRunResult f a)
toNotFound String -> Either SourceRunError (Compose SourceRunResult f x)
parse Maybe String
_optDefaultStr
      where
        parse :: String -> Either SourceRunError (Compose SourceRunResult f x)
parse =
          (String -> Either SourceRunError (Compose SourceRunResult f x))
-> (f x -> Either SourceRunError (Compose SourceRunResult f x))
-> Either String (f x)
-> Either SourceRunError (Compose SourceRunResult f x)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either SourceRunError (Compose SourceRunResult f x)
toErr f x -> Either SourceRunError (Compose SourceRunResult f x)
forall (g :: * -> *) a a.
g a -> Either a (Compose SourceRunResult g a)
toParsed (Either String (f x)
 -> Either SourceRunError (Compose SourceRunResult f x))
-> OptReader (f x)
-> String
-> Either SourceRunError (Compose SourceRunResult f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptReader (f x)
_optReader
        toNotFound :: Either a (Compose SourceRunResult f a)
toNotFound =
          Compose SourceRunResult f a
-> Either a (Compose SourceRunResult f a)
forall a b. b -> Either a b
Right (Compose SourceRunResult f a
 -> Either a (Compose SourceRunResult f a))
-> Compose SourceRunResult f a
-> Either a (Compose SourceRunResult f a)
forall a b. (a -> b) -> a -> b
$ SourceRunResult (f a) -> Compose SourceRunResult f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (SourceRunResult (f a) -> Compose SourceRunResult f a)
-> SourceRunResult (f a) -> Compose SourceRunResult f a
forall a b. (a -> b) -> a -> b
$ a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a) -> SourceRunResult a -> SourceRunResult (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceRunResult a
forall a. SourceRunResult a
OptNotFound
        toErr :: String -> Either SourceRunError (Compose SourceRunResult f x)
toErr =
          SourceRunError
-> Either SourceRunError (Compose SourceRunResult f x)
forall a b. a -> Either a b
Left (SourceRunError
 -> Either SourceRunError (Compose SourceRunResult f x))
-> (String -> SourceRunError)
-> String
-> Either SourceRunError (Compose SourceRunResult f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt (f x) -> String -> String -> SourceRunError
forall a. Opt a -> String -> String -> SourceRunError
sourceRunError Opt (f x)
opt "DefaultStrSource"
        toParsed :: g a -> Either a (Compose SourceRunResult g a)
toParsed =
          Compose SourceRunResult g a
-> Either a (Compose SourceRunResult g a)
forall a b. b -> Either a b
Right (Compose SourceRunResult g a
 -> Either a (Compose SourceRunResult g a))
-> (g a -> Compose SourceRunResult g a)
-> g a
-> Either a (Compose SourceRunResult g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRunResult (g a) -> Compose SourceRunResult g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (SourceRunResult (g a) -> Compose SourceRunResult g a)
-> (g a -> SourceRunResult (g a))
-> g a
-> Compose SourceRunResult g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> SourceRunResult (g a)
forall a. a -> SourceRunResult a
OptParsed