{-# 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)
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
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")
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
data Profile
= Profile
{ Profile -> Name
name :: !Name
, Profile -> State
state :: !State
, Profile -> [Entry]
entries :: ![Entry]
}
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
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)
data State
= Dangling
| Valid
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"
data Entry
= Entry
{ Entry -> Mount
mountPath :: !Mount.Mount
, Entry -> Absolute
originPath :: !Path.Absolute
}
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