{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
module Options.Harg.Sources.Env
( EnvSource (..),
EnvSourceVal (..),
)
where
import qualified Data.Barbie 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
data EnvSource (f :: Type -> Type) = EnvSource
deriving (Generic, B.FunctorB, B.TraversableB, B.ProductB)
newtype EnvSourceVal = EnvSourceVal Environment
instance GetSource EnvSource f where
type SourceVal EnvSource = EnvSourceVal
getSource HargCtx {..} _ =
pure (EnvSourceVal _hcEnv)
instance
( B.FunctorB a,
B.TraversableB a
) =>
RunSource EnvSourceVal a
where
runSource (EnvSourceVal e) opt =
[runEnvVarSource e opt]
lookupEnv ::
Environment ->
String ->
Maybe String
lookupEnv env x =
snd <$> find ((== x) . fst) 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 env =
B.btraverse go
where
go ::
Compose Opt f x ->
Either SourceRunError (Compose SourceRunResult f x)
go (Compose opt@Opt {..}) =
maybe toNotFound (parse . lookupEnv env) _optEnvVar
where
parse =
maybe toNotFound (either toErr toParsed . _optReader)
toNotFound =
Right $ Compose $ pure <$> OptNotFound
toErr =
Left . sourceRunError opt "EnvSource"
toParsed =
Right . Compose . OptParsed