{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Options.Harg.Sources.YAML
( YAMLSource (..),
)
where
import qualified Barbies as B
import Control.Exception (displayException)
import qualified Data.ByteString as BS
import Data.Functor.Compose (Compose (..))
import Data.Functor.Identity (Identity (..))
import qualified Data.Yaml as YAML
import GHC.Generics (Generic)
import Options.Harg.Sources.Types
import Options.Harg.Types
import Options.Harg.Util (readFileBS)
newtype YAMLSource f = YAMLSource (f ConfigFile)
deriving ((forall x. YAMLSource f -> Rep (YAMLSource f) x)
-> (forall x. Rep (YAMLSource f) x -> YAMLSource f)
-> Generic (YAMLSource f)
forall x. Rep (YAMLSource f) x -> YAMLSource f
forall x. YAMLSource f -> Rep (YAMLSource f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (YAMLSource f) x -> YAMLSource f
forall (f :: * -> *) x. YAMLSource f -> Rep (YAMLSource f) x
$cto :: forall (f :: * -> *) x. Rep (YAMLSource f) x -> YAMLSource f
$cfrom :: forall (f :: * -> *) x. YAMLSource f -> Rep (YAMLSource f) x
Generic, (forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> YAMLSource f -> YAMLSource g)
-> FunctorB YAMLSource
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) -> YAMLSource f -> YAMLSource g
bmap :: (forall a. f a -> g a) -> YAMLSource f -> YAMLSource g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> YAMLSource f -> YAMLSource g
B.FunctorB, FunctorB YAMLSource
FunctorB YAMLSource =>
(forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> YAMLSource f -> e (YAMLSource g))
-> TraversableB YAMLSource
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)) -> YAMLSource f -> e (YAMLSource g)
btraverse :: (forall a. f a -> e (g a)) -> YAMLSource f -> e (YAMLSource g)
$cbtraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> YAMLSource f -> e (YAMLSource g)
$cp1TraversableB :: FunctorB YAMLSource
B.TraversableB, FunctorB YAMLSource
FunctorB YAMLSource =>
(forall (f :: * -> *). (forall a. f a) -> YAMLSource f)
-> (forall (f :: * -> *) (g :: * -> *).
YAMLSource f -> YAMLSource g -> YAMLSource (Product f g))
-> ApplicativeB YAMLSource
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) -> YAMLSource f
forall (f :: * -> *) (g :: * -> *).
YAMLSource f -> YAMLSource g -> YAMLSource (Product f g)
bprod :: YAMLSource f -> YAMLSource g -> YAMLSource (Product f g)
$cbprod :: forall (f :: * -> *) (g :: * -> *).
YAMLSource f -> YAMLSource g -> YAMLSource (Product f g)
bpure :: (forall a. f a) -> YAMLSource f
$cbpure :: forall (f :: * -> *). (forall a. f a) -> YAMLSource f
$cp1ApplicativeB :: FunctorB YAMLSource
B.ApplicativeB)
data YAMLSourceVal
= YAMLSourceVal BS.ByteString
| YAMLSourceNotRequired
instance GetSource YAMLSource Identity where
type SourceVal YAMLSource = YAMLSourceVal
getSource :: HargCtx -> YAMLSource Identity -> IO (SourceVal YAMLSource)
getSource _ctx :: HargCtx
_ctx (YAMLSource (Identity (ConfigFile path :: FilePath
path))) =
ByteString -> YAMLSourceVal
YAMLSourceVal (ByteString -> YAMLSourceVal) -> IO ByteString -> IO YAMLSourceVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
readFileBS FilePath
path
getSource _ctx :: HargCtx
_ctx (YAMLSource (Identity NoConfigFile)) =
YAMLSourceVal -> IO YAMLSourceVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure YAMLSourceVal
YAMLSourceNotRequired
instance
( YAML.FromJSON (a Maybe),
B.FunctorB a
) =>
RunSource YAMLSourceVal a
where
runSource :: YAMLSourceVal
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource (YAMLSourceVal j :: ByteString
j) opt :: a (Compose Opt f)
opt =
[ByteString
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall (a :: (* -> *) -> *) (f :: * -> *).
(FunctorB a, FromJSON (a Maybe), Applicative f) =>
ByteString
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runYAMLSource ByteString
j a (Compose Opt f)
opt]
runSource YAMLSourceNotRequired _ =
[]
runYAMLSource ::
forall a f.
( B.FunctorB a,
YAML.FromJSON (a Maybe),
Applicative f
) =>
BS.ByteString ->
a (Compose Opt f) ->
Either SourceRunError (a (Compose SourceRunResult f))
runYAMLSource :: ByteString
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runYAMLSource yaml :: ByteString
yaml _opt :: a (Compose Opt f)
_opt =
case Either ParseException (a Maybe)
res of
Right v :: a Maybe
v -> a (Compose SourceRunResult f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. b -> Either a b
Right (a (Compose SourceRunResult f)
-> Either SourceRunError (a (Compose SourceRunResult f)))
-> a (Compose SourceRunResult f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. (a -> b) -> a -> b
$ (forall a. Maybe a -> Compose SourceRunResult f a)
-> a Maybe -> a (Compose SourceRunResult f)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
B.bmap forall a. Maybe a -> Compose SourceRunResult f a
toSuccess a Maybe
v
Left exc :: ParseException
exc -> SourceRunError
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. a -> Either a b
Left (SourceRunError
-> Either SourceRunError (a (Compose SourceRunResult f)))
-> SourceRunError
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. (a -> b) -> a -> b
$ ParseException -> SourceRunError
toError ParseException
exc
where
res :: Either YAML.ParseException (a Maybe)
res :: Either ParseException (a Maybe)
res =
ByteString -> Either ParseException (a Maybe)
forall a. FromJSON a => ByteString -> Either ParseException a
YAML.decodeEither' ByteString
yaml
toSuccess :: Maybe x -> Compose SourceRunResult f x
toSuccess :: Maybe x -> Compose SourceRunResult f x
toSuccess mx :: Maybe x
mx =
SourceRunResult (f x) -> Compose SourceRunResult f x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (SourceRunResult (f x) -> Compose SourceRunResult f x)
-> SourceRunResult (f x) -> Compose SourceRunResult f x
forall a b. (a -> b) -> a -> b
$ x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> f x) -> SourceRunResult x -> SourceRunResult (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceRunResult x
-> (x -> SourceRunResult x) -> Maybe x -> SourceRunResult x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SourceRunResult x
forall a. SourceRunResult a
OptNotFound x -> SourceRunResult x
forall a. a -> SourceRunResult a
OptParsed Maybe x
mx
toError :: YAML.ParseException -> SourceRunError
toError :: ParseException -> SourceRunError
toError exc :: ParseException
exc =
Maybe SomeOpt -> FilePath -> FilePath -> SourceRunError
SourceRunError Maybe SomeOpt
forall a. Maybe a
Nothing "YAMLSource" (ParseException -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseException
exc)