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