module Hix.Json where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (throwE)
import qualified Data.Aeson as Aeson
import Data.Aeson (FromJSON, fromJSON)
import Exon (exon)

import Hix.Data.Error (Error (GhciError))
import Hix.Monad (M)
import Hix.Optparse (JsonConfig (JsonConfig))

jsonConfig ::
  FromJSON a =>
  JsonConfig ->
  M a
jsonConfig :: forall a. FromJSON a => JsonConfig -> M a
jsonConfig (JsonConfig IO (Either String Value)
mv) =
  IO (Either String Value)
-> ReaderT Env (ExceptT Error IO) (Either String Value)
forall a. IO a -> ReaderT Env (ExceptT Error IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either String Value)
mv ReaderT Env (ExceptT Error IO) (Either String Value)
-> (Either String Value -> ReaderT Env (ExceptT Error IO) a)
-> ReaderT Env (ExceptT Error IO) a
forall a b.
ReaderT Env (ExceptT Error IO) a
-> (a -> ReaderT Env (ExceptT Error IO) b)
-> ReaderT Env (ExceptT Error IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
msg -> Text -> ReaderT Env (ExceptT Error IO) a
forall {a}. Text -> ReaderT Env (ExceptT Error IO) a
failure [exon|Invalid JSON: #{toText msg}|]
    Right Value
v -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
      Aeson.Success a
a -> a -> ReaderT Env (ExceptT Error IO) a
forall a. a -> ReaderT Env (ExceptT Error IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
      Aeson.Error String
err -> Text -> ReaderT Env (ExceptT Error IO) a
forall {a}. Text -> ReaderT Env (ExceptT Error IO) a
failure [exon|Invalid JSON: #{toText err}
#{show v}|]
  where
    failure :: Text -> ReaderT Env (ExceptT Error IO) a
failure = ExceptT Error IO a -> ReaderT Env (ExceptT Error IO) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error IO a -> ReaderT Env (ExceptT Error IO) a)
-> (Text -> ExceptT Error IO a)
-> Text
-> ReaderT Env (ExceptT Error IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> ExceptT Error IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error IO a)
-> (Text -> Error) -> Text -> ExceptT Error IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
GhciError