{- |
Module:      PFile.Profile.Internal.Profile
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)

Core types and functions related to profiles.
-}

{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}

module PFile.Profile.Internal.Profile
  ( absoluteRoot
  , profileState
  , profileRoot
  , Profile (..)
  , Name (..)
  , State (..)
  , Entry (..)
  ) where

import           Control.Monad (MonadFail (..))
import           Data.Aeson    (FromJSON (..), ToJSON (..), withText)
import           PFile.Env     (Env (..))
import qualified PFile.Mount   as Mount
import           PFile.Path    ((<//>))
import qualified PFile.Path    as Path
import           Protolude     hiding (State)

-- | Get directory path where entries of a 'Profile' named 'Name' are stored.
--
-- @since 0.1.0.0
absoluteRoot :: MonadReader Env m => Name -> m Mount.Root
absoluteRoot :: forall (m :: * -> *). MonadReader Env m => Name -> m Root
absoluteRoot Name
name = do
  Absolute
root <- Name -> m Absolute
forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileRoot Name
name
  Absolute
root Absolute -> FilePath -> Absolute
<//> FilePath
"absolute"
    Absolute -> (Absolute -> m Root) -> m Root
forall a b. a -> (a -> b) -> b
& Root -> m Root
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Root -> m Root) -> (Absolute -> Root) -> Absolute -> m Root
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Root
Mount.Root

-- | Get file path where serialized 'Profile' named 'Name' is stored.
--
-- @since 0.1.0.0
profileState :: MonadReader Env m => Name -> m Path.Absolute
profileState :: forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileState Name
name = Name -> m Absolute
forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileRoot Name
name m Absolute -> (Absolute -> Absolute) -> m Absolute
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Absolute -> FilePath -> Absolute
<//> FilePath
"state.json")

-- | Get directory path where 'absoluteRoot' and 'profileState' of a 'Profile'
-- named 'Name' are located.
--
-- @since 0.1.0.0
profileRoot :: MonadReader Env m => Name -> m Path.Absolute
profileRoot :: forall (m :: * -> *). MonadReader Env m => Name -> m Absolute
profileRoot (Name Text
name) = do
  Env {Absolute
profilesHomeDirPath :: Absolute
profilesHomeDirPath :: Env -> Absolute
profilesHomeDirPath} <- m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Absolute -> m Absolute
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Absolute -> m Absolute) -> Absolute -> m Absolute
forall a b. (a -> b) -> a -> b
$ Absolute
profilesHomeDirPath Absolute -> FilePath -> Absolute
<//> Text -> FilePath
forall a b. ConvertText a b => a -> b
toS Text
name

-- | 'Profile' holds a list of 'Entry'ies.
--
-- @since 0.1.0.0
data Profile
  = Profile
      { Profile -> Name
name    :: !Name
        -- ^ 'Name' of a 'Profile'.
      , Profile -> State
state   :: !State
        -- ^ Current 'State' of a 'Profile'.
      , Profile -> [Entry]
entries :: ![Entry]
        -- ^ List of a 'Profile' 'Entry'ies.
      }
  deriving ((forall x. Profile -> Rep Profile x)
-> (forall x. Rep Profile x -> Profile) -> Generic Profile
forall x. Rep Profile x -> Profile
forall x. Profile -> Rep Profile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Profile -> Rep Profile x
from :: forall x. Profile -> Rep Profile x
$cto :: forall x. Rep Profile x -> Profile
to :: forall x. Rep Profile x -> Profile
Generic)

instance FromJSON Profile
instance ToJSON Profile

-- | 'Name' of a 'Profile'.
--
-- @since 0.1.0.0
newtype Name
  = Name { Name -> Text
unName :: Text }
  deriving newtype (Value -> Parser [Name]
Value -> Parser Name
(Value -> Parser Name) -> (Value -> Parser [Name]) -> FromJSON Name
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Name
parseJSON :: Value -> Parser Name
$cparseJSONList :: Value -> Parser [Name]
parseJSONList :: Value -> Parser [Name]
FromJSON, [Name] -> Value
[Name] -> Encoding
Name -> Value
Name -> Encoding
(Name -> Value)
-> (Name -> Encoding)
-> ([Name] -> Value)
-> ([Name] -> Encoding)
-> ToJSON Name
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Name -> Value
toJSON :: Name -> Value
$ctoEncoding :: Name -> Encoding
toEncoding :: Name -> Encoding
$ctoJSONList :: [Name] -> Value
toJSONList :: [Name] -> Value
$ctoEncodingList :: [Name] -> Encoding
toEncodingList :: [Name] -> Encoding
ToJSON)

-- | 'Profile's state.
--
-- @since 0.1.0.0
data State
  = Dangling
  -- ^ When an error is encountered during
  -- 'PFile.Profile.Internal.Registry.pushAll',
  -- 'PFile.Profile.Internal.Lifetime.create' attempts to rollback. If the
  -- rollback fails, the profile is considered 'Dangling'.
  | Valid
  -- ^ When 'PFile.Profile.Internal.Lifetime.create' succeeds, the created
  -- profile has 'Valid' state.

instance FromJSON State where
  parseJSON :: Value -> Parser State
parseJSON = FilePath -> (Text -> Parser State) -> Value -> Parser State
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
withText FilePath
"State" \case
    Text
"dangling" -> State -> Parser State
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
Dangling
    Text
"valid"    -> State -> Parser State
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
Valid
    Text
s          -> FilePath -> Parser State
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser State)
-> (Text -> FilePath) -> Text -> Parser State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a b. ConvertText a b => a -> b
toS (Text -> Parser State) -> Text -> Parser State
forall a b. (a -> b) -> a -> b
$ Text
"Unable to parse State: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

instance ToJSON State where
  toJSON :: State -> Value
toJSON = \case
    State
Dangling -> Value
"dangling"
    State
Valid    -> Value
"valid"

-- | 'Entry' represents a filesystem's object (directory, directory link, file,
-- file link) that is 'PFile.Mount.mount'ed (or
-- 'PFile.Profile.Internal.Registry.push'ed) inside of a 'Profile'.
--
-- @since 0.1.0.0
data Entry
  = Entry
      { Entry -> Mount
mountPath  :: !Mount.Mount
      -- ^ Path to a filesystem's object mounted inside of a 'Profile'.
      , Entry -> Absolute
originPath :: !Path.Absolute
      -- ^ Path to a filesystem's object original location before
      -- 'PFile.Profile.Internal.Registry.push'ing to a 'Profile'.
      }
  deriving ((forall x. Entry -> Rep Entry x)
-> (forall x. Rep Entry x -> Entry) -> Generic Entry
forall x. Rep Entry x -> Entry
forall x. Entry -> Rep Entry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Entry -> Rep Entry x
from :: forall x. Entry -> Rep Entry x
$cto :: forall x. Rep Entry x -> Entry
to :: forall x. Rep Entry x -> Entry
Generic)

instance FromJSON Entry
instance ToJSON Entry