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

module Options.Harg.Sources.Env
  ( EnvSource (..),
    EnvSourceVal (..),
  )
where

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

-- | Source that enables a parser to read options from environment variables.
data EnvSource (f :: Type -> Type) = EnvSource
  deriving ((forall x. EnvSource f -> Rep (EnvSource f) x)
-> (forall x. Rep (EnvSource f) x -> EnvSource f)
-> Generic (EnvSource f)
forall x. Rep (EnvSource f) x -> EnvSource f
forall x. EnvSource f -> Rep (EnvSource f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (EnvSource f) x -> EnvSource f
forall (f :: * -> *) x. EnvSource f -> Rep (EnvSource f) x
$cto :: forall (f :: * -> *) x. Rep (EnvSource f) x -> EnvSource f
$cfrom :: forall (f :: * -> *) x. EnvSource f -> Rep (EnvSource f) x
Generic, (forall (f :: * -> *) (g :: * -> *).
 (forall a. f a -> g a) -> EnvSource f -> EnvSource g)
-> FunctorB EnvSource
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) -> EnvSource f -> EnvSource g
bmap :: (forall a. f a -> g a) -> EnvSource f -> EnvSource g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> EnvSource f -> EnvSource g
B.FunctorB, FunctorB EnvSource
FunctorB EnvSource =>
(forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
 Applicative e =>
 (forall a. f a -> e (g a)) -> EnvSource f -> e (EnvSource g))
-> TraversableB EnvSource
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)) -> EnvSource f -> e (EnvSource g)
btraverse :: (forall a. f a -> e (g a)) -> EnvSource f -> e (EnvSource g)
$cbtraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> EnvSource f -> e (EnvSource g)
$cp1TraversableB :: FunctorB EnvSource
B.TraversableB, FunctorB EnvSource
FunctorB EnvSource =>
(forall (f :: * -> *). (forall a. f a) -> EnvSource f)
-> (forall (f :: * -> *) (g :: * -> *).
    EnvSource f -> EnvSource g -> EnvSource (Product f g))
-> ApplicativeB EnvSource
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) -> EnvSource f
forall (f :: * -> *) (g :: * -> *).
EnvSource f -> EnvSource g -> EnvSource (Product f g)
bprod :: EnvSource f -> EnvSource g -> EnvSource (Product f g)
$cbprod :: forall (f :: * -> *) (g :: * -> *).
EnvSource f -> EnvSource g -> EnvSource (Product f g)
bpure :: (forall a. f a) -> EnvSource f
$cbpure :: forall (f :: * -> *). (forall a. f a) -> EnvSource f
$cp1ApplicativeB :: FunctorB EnvSource
B.ApplicativeB)

-- | Value of 'EnvSource', which is an association list between environment
-- variable names and values (strings).
newtype EnvSourceVal = EnvSourceVal Environment

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

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

-- | Try to get a value from the environment variable association list.
lookupEnv ::
  Environment ->
  String ->
  Maybe String
lookupEnv :: Environment -> String -> Maybe String
lookupEnv env :: Environment
env x :: String
x =
  (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> Maybe (String, String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, String) -> Bool) -> Environment -> Maybe (String, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) Environment
env

runEnvVarSource ::
  forall a f.
  ( B.FunctorB a,
    B.TraversableB a,
    Applicative f
  ) =>
  Environment ->
  a (Compose Opt f) ->
  Either SourceRunError (a (Compose SourceRunResult f))
runEnvVarSource :: Environment
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runEnvVarSource env :: Environment
env =
  (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 (Maybe String -> Either SourceRunError (Compose SourceRunResult f x)
parse (Maybe String
 -> Either SourceRunError (Compose SourceRunResult f x))
-> (String -> Maybe String)
-> String
-> Either SourceRunError (Compose SourceRunResult f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> String -> Maybe String
lookupEnv Environment
env) Maybe String
_optEnvVar
      where
        parse :: Maybe String -> Either SourceRunError (Compose SourceRunResult f x)
parse =
          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))
-> (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 "EnvSource"
        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