{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}

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           GHC.Generics
import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS
import qualified HaskellWorks.Polysemy.Data.Text            as T
import           HaskellWorks.Polysemy.Error
import           HaskellWorks.Polysemy.Prelude
import           Polysemy
import           Polysemy.Error
import           Polysemy.Log

newtype JsonDecodeError = JsonDecodeError { JsonDecodeError -> String
message :: String }
  deriving (JsonDecodeError -> JsonDecodeError -> Bool
(JsonDecodeError -> JsonDecodeError -> Bool)
-> (JsonDecodeError -> JsonDecodeError -> Bool)
-> Eq JsonDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonDecodeError -> JsonDecodeError -> Bool
== :: JsonDecodeError -> JsonDecodeError -> Bool
$c/= :: JsonDecodeError -> JsonDecodeError -> Bool
/= :: JsonDecodeError -> JsonDecodeError -> Bool
Eq, (forall x. JsonDecodeError -> Rep JsonDecodeError x)
-> (forall x. Rep JsonDecodeError x -> JsonDecodeError)
-> Generic JsonDecodeError
forall x. Rep JsonDecodeError x -> JsonDecodeError
forall x. JsonDecodeError -> Rep JsonDecodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonDecodeError -> Rep JsonDecodeError x
from :: forall x. JsonDecodeError -> Rep JsonDecodeError x
$cto :: forall x. Rep JsonDecodeError x -> JsonDecodeError
to :: forall x. Rep JsonDecodeError x -> JsonDecodeError
Generic, Int -> JsonDecodeError -> ShowS
[JsonDecodeError] -> ShowS
JsonDecodeError -> String
(Int -> JsonDecodeError -> ShowS)
-> (JsonDecodeError -> String)
-> ([JsonDecodeError] -> ShowS)
-> Show JsonDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonDecodeError -> ShowS
showsPrec :: Int -> JsonDecodeError -> ShowS
$cshow :: JsonDecodeError -> String
show :: JsonDecodeError -> String
$cshowList :: [JsonDecodeError] -> ShowS
showList :: [JsonDecodeError] -> ShowS
Show)

newtype YamlDecodeError = YamlDecodeError { YamlDecodeError -> String
message :: String }
  deriving (YamlDecodeError -> YamlDecodeError -> Bool
(YamlDecodeError -> YamlDecodeError -> Bool)
-> (YamlDecodeError -> YamlDecodeError -> Bool)
-> Eq YamlDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YamlDecodeError -> YamlDecodeError -> Bool
== :: YamlDecodeError -> YamlDecodeError -> Bool
$c/= :: YamlDecodeError -> YamlDecodeError -> Bool
/= :: YamlDecodeError -> YamlDecodeError -> Bool
Eq, (forall x. YamlDecodeError -> Rep YamlDecodeError x)
-> (forall x. Rep YamlDecodeError x -> YamlDecodeError)
-> Generic YamlDecodeError
forall x. Rep YamlDecodeError x -> YamlDecodeError
forall x. YamlDecodeError -> Rep YamlDecodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. YamlDecodeError -> Rep YamlDecodeError x
from :: forall x. YamlDecodeError -> Rep YamlDecodeError x
$cto :: forall x. Rep YamlDecodeError x -> YamlDecodeError
to :: forall x. Rep YamlDecodeError x -> YamlDecodeError
Generic, Int -> YamlDecodeError -> ShowS
[YamlDecodeError] -> ShowS
YamlDecodeError -> String
(Int -> YamlDecodeError -> ShowS)
-> (YamlDecodeError -> String)
-> ([YamlDecodeError] -> ShowS)
-> Show YamlDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YamlDecodeError -> ShowS
showsPrec :: Int -> YamlDecodeError -> ShowS
$cshow :: YamlDecodeError -> String
show :: YamlDecodeError -> String
$cshowList :: [YamlDecodeError] -> ShowS
showList :: [YamlDecodeError] -> ShowS
Show)

-- | 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) =>
String -> Sem r a
readJsonFile String
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
<> String -> Text
T.pack String
filePath
  ByteString
contents <- String -> Sem r ByteString
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
String -> Sem r ByteString
LBS.readFile String
filePath
  ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode ByteString
contents
    Either String a -> (Either String a -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& (String -> Sem r a) -> Either String a -> Sem r a
forall (m :: * -> *) e a.
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)
-> (String -> JsonDecodeError) -> String -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonDecodeError
JsonDecodeError)


-- | 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) =>
String -> Sem r a
readYamlFile String
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
<> String -> Text
T.pack String
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
<$> String -> Sem r ByteString
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
String -> Sem r ByteString
LBS.readFile String
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 (m :: * -> *) e a.
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
. String -> YamlDecodeError
YamlDecodeError (String -> YamlDecodeError)
-> (ParseException -> String) -> ParseException -> YamlDecodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
Y.prettyPrintParseException)