{- |
Module:      PFile.Profile.Internal.Serialization
Copyright:   (c) 2024 Illia Shkroba
License:     BSD3
Maintainer:  Illia Shkroba <is@pjwstk.edu.pl>
Stability:   unstable
Portability: non-portable (Non-Unix systems are not supported)

Types and functions for profiles serialization.
-}

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module PFile.Profile.Internal.Serialization
  ( load
  , showLoadError
  , LoadError (..)
  , dump
  , showDumpError
  , DumpError (..)
  ) where

import           Data.Aeson
  ( eitherDecodeFileStrict
  , encodeFile
  )
import           PFile.Aeson                    (encodePretty)
import           PFile.Env                      (Env)
import           PFile.Error                    (liftIOWithError, modifyError)
import qualified PFile.Log                      as Log
import qualified PFile.Path                     as Path
import           PFile.Profile.Internal.Profile
  ( Name (..)
  , Profile (..)
  , profileState
  )
import           Protolude

-- | Load 'Profile' named 'Name' from its
-- 'PFile.Profile.Internal.Profile.profileState'.
--
-- @since 0.1.0.0
load ::
     (MonadReader Env m, MonadError LoadError m, MonadIO m) => Name -> m Profile
load :: forall (m :: * -> *).
(MonadReader Env m, MonadError LoadError m, MonadIO m) =>
Name -> m Profile
load Name
name = do
  Absolute
statePath <- Name -> m Absolute
forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileState Name
name
  Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$  Text
"Load profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" from state: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
statePath
  Profile
profile <- String -> IO (Either String Profile)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict (Absolute -> String
Path.unAbsolute Absolute
statePath)
    IO (Either String Profile)
-> (IOException -> LoadError) -> m (Either String Profile)
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> LoadError
LoadError Absolute
statePath
    m (Either String Profile)
-> (Either String Profile -> m Profile) -> m Profile
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> m Profile)
-> (Profile -> m Profile) -> Either String Profile -> m Profile
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (LoadError -> m Profile
forall a. LoadError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LoadError -> m Profile)
-> (String -> LoadError) -> String -> m Profile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> String -> LoadError
DecodeError Absolute
statePath) Profile -> m Profile
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$  Text
"Loaded profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\":\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Profile -> Text
forall a. ToJSON a => a -> Text
encodePretty Profile
profile
  Profile -> m Profile
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Profile
profile

showLoadError :: LoadError -> Text
showLoadError :: LoadError -> Text
showLoadError = \case
  LoadError Absolute
path IOException
cause
    -> Text
"Unable to load profile from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv String b) => a -> b
show IOException
cause
  DecodeError Absolute
path String
cause
    -> Text
"Unable to decode profile from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
cause Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"."

-- | Error thrown by 'load'.
--
-- @since 0.1.0.0
data LoadError
  = LoadError !Path.Absolute !IOException
  -- ^ 'IOException' was encountered during 'eitherDecodeFileStrict'.
  | DecodeError !Path.Absolute ![Char]
  -- ^ Decoding error was encountered during 'eitherDecodeFileStrict'.

-- | Dump 'Profile' to its 'PFile.Profile.Internal.Profile.profileState'.
--
-- @since 0.1.0.0
dump ::
     (MonadReader Env m, MonadError DumpError m, MonadIO m) => Profile -> m ()
dump :: forall (m :: * -> *).
(MonadReader Env m, MonadError DumpError m, MonadIO m) =>
Profile -> m ()
dump profile :: Profile
profile@Profile {Name
name :: Name
name :: Profile -> Name
name} = do
  Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$  Text
"Dump profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\":\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Profile -> Text
forall a. ToJSON a => a -> Text
encodePretty Profile
profile
  Absolute
statePath <- Name -> m Absolute
forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileState Name
name
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
Path.createParent Absolute
statePath
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> DumpError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> DumpError
CreateParentInDumpError
  String -> Profile -> IO ()
forall a. ToJSON a => String -> a -> IO ()
encodeFile (Absolute -> String
Path.unAbsolute Absolute
statePath) Profile
profile
    IO () -> (IOException -> DumpError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> DumpError
DumpError Absolute
statePath
  Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$  Text
"Dumped profile \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" to state: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
statePath

showDumpError :: DumpError -> Text
showDumpError :: DumpError -> Text
showDumpError = \case
  CreateParentInDumpError CreateParentError
cause -> CreateParentError -> Text
Path.showCreateParentError CreateParentError
cause
  DumpError Absolute
path IOException
cause
    -> Text
"Unable to dump profile to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv String b) => a -> b
show IOException
cause

-- | Error thrown by 'dump'.
--
-- @since 0.1.0.0
data DumpError
  = CreateParentInDumpError !Path.CreateParentError
  -- ^ Unable to create a parent directory for
  -- 'PFile.Profile.Internal.Profile.profileState'.
  | DumpError !Path.Absolute !IOException
  -- ^ 'IOException' was encountered during 'encodeFile'.