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