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

-- | Read the 'filePath' file as JSON. Use @readJsonFile \@'Value'@ to decode into 'Value'.
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)

-- | Read the 'filePath' file as YAML.
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)