module HaskellWorks.Polysemy.File
( JsonDecodeError(..)
, YamlDecodeError(..)
, readJsonFile
, readYamlFile
) where
import Data.Aeson
import qualified Data.Aeson as J
import qualified Data.Yaml as Y
import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS
import qualified HaskellWorks.Polysemy.Data.Text as T
import HaskellWorks.Polysemy.Error
import HaskellWorks.Polysemy.Error.Types.JsonDecodeError
import HaskellWorks.Polysemy.Error.Types.YamlDecodeError
import HaskellWorks.Polysemy.Prelude
import Polysemy
import Polysemy.Error
import Polysemy.Log
readJsonFile :: forall a r. ()
=> FromJSON a
=> HasCallStack
=> Member (Error IOException) r
=> Member (Error JsonDecodeError) r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r a
readJsonFile :: forall a (r :: EffectRow).
(FromJSON a, HasCallStack, Member (Error IOException) r,
Member (Error JsonDecodeError) r, Member (Embed IO) r,
Member Log r) =>
FilePath -> Sem r a
readJsonFile FilePath
filePath = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ do
Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
info (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Reading JSON file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
filePath
ByteString
contents <- FilePath -> Sem r ByteString
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
FilePath -> Sem r ByteString
LBS.readFile FilePath
filePath
ByteString -> Either FilePath a
forall a. FromJSON a => ByteString -> Either FilePath a
J.eitherDecode ByteString
contents
Either FilePath a -> (Either FilePath a -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& (FilePath -> Sem r a) -> Either FilePath a -> Sem r a
forall e a (m :: * -> *).
Monad m =>
(e -> m a) -> Either e a -> m a
onLeft (JsonDecodeError -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (JsonDecodeError -> Sem r a)
-> (FilePath -> JsonDecodeError) -> FilePath -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> JsonDecodeError
forall a. ToText a => a -> JsonDecodeError
newJsonDecodeError)
readYamlFile :: forall a r. ()
=> FromJSON a
=> HasCallStack
=> Member (Error IOException) r
=> Member (Error JsonDecodeError) r
=> Member (Error YamlDecodeError) r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r a
readYamlFile :: forall a (r :: EffectRow).
(FromJSON a, HasCallStack, Member (Error IOException) r,
Member (Error JsonDecodeError) r, Member (Error YamlDecodeError) r,
Member (Embed IO) r, Member Log r) =>
FilePath -> Sem r a
readYamlFile FilePath
filePath = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ do
Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
info (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Reading YAML file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
filePath
ByteString
contents <- ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> Sem r ByteString -> Sem r ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Sem r ByteString
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
FilePath -> Sem r ByteString
LBS.readFile FilePath
filePath
ByteString -> Either ParseException a
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' ByteString
contents
Either ParseException a
-> (Either ParseException a -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& (ParseException -> Sem r a) -> Either ParseException a -> Sem r a
forall e a (m :: * -> *).
Monad m =>
(e -> m a) -> Either e a -> m a
onLeft (YamlDecodeError -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (YamlDecodeError -> Sem r a)
-> (ParseException -> YamlDecodeError) -> ParseException -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YamlDecodeError
YamlDecodeError (Text -> YamlDecodeError)
-> (ParseException -> Text) -> ParseException -> YamlDecodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> (ParseException -> FilePath) -> ParseException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
Y.prettyPrintParseException)