{- |
Module:      PFile.Profile.Internal.List
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 listing profiles.
-}

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

module PFile.Profile.Internal.List
  ( list
  , showListError
  , ListError (..)
  , ListOptions (..)
  ) where

import           PFile.Env                            (Env (..))
import           PFile.Error                          (liftIOWithError)
import qualified PFile.Log                            as Log
import           PFile.Path
  ( doesPathExist
  , listDirectory
  , takeBaseName
  )
import qualified PFile.Path                           as Path
import           PFile.Profile.Internal.Profile
  ( Name (..)
  , Profile (..)
  , State (..)
  )
import           PFile.Profile.Internal.Serialization (load, showLoadError)
import           Protolude                            hiding (list, state)

-- | List profiles in 'PFile.Env.profilesHomeDirPath' directory.
--
-- @since 0.1.0.0
list ::
     forall m. (MonadReader Env m, MonadError ListError m, MonadIO m)
  => ListOptions
  -- ^ Options that control 'list' behaviour (currently only
  -- 'shouldFilterDangling').
  -> m [Profile]
list :: forall (m :: * -> *).
(MonadReader Env m, MonadError ListError m, MonadIO m) =>
ListOptions -> m [Profile]
list ListOptions {Bool
shouldFilterDangling :: ListOptions -> Bool
shouldFilterDangling :: Bool
shouldFilterDangling} = do
  Env {Absolute
profilesHomeDirPath :: Env -> Absolute
profilesHomeDirPath :: Absolute
profilesHomeDirPath} <- m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesPathExist Absolute
profilesHomeDirPath) (m () -> m ()) -> (ListError -> m ()) -> ListError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListError -> m ()
forall a. ListError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (ListError -> m ()) -> ListError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> ListError
ProfilesHomeDirDoesNotExistError Absolute
profilesHomeDirPath
  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
"List profile names in "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
profilesHomeDirPath
  [Name]
names <- Absolute -> IO [Absolute]
forall (m :: * -> *). MonadIO m => Absolute -> m [Absolute]
listDirectory Absolute
profilesHomeDirPath
    IO [Absolute] -> (IOException -> ListError) -> m [Absolute]
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> ListError
ListDirectoryError Absolute
profilesHomeDirPath
    m [Absolute] -> ([Absolute] -> [Name]) -> m [Name]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Absolute -> Name) -> [Absolute] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Name
Name (Text -> Name) -> (Absolute -> Text) -> Absolute -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (Absolute -> String) -> Absolute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> String
takeBaseName)
  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 profiles: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Name -> Text
unName (Name -> Text) -> [Name] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names)
  [Profile]
profiles <- [Maybe Profile] -> [Profile]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Profile] -> [Profile]) -> m [Maybe Profile] -> m [Profile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> (Name -> m (Maybe Profile)) -> m [Maybe Profile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Name]
names \Name
name ->
    Name -> ExceptT LoadError m Profile
forall (m :: * -> *).
(MonadReader Env m, MonadError LoadError m, MonadIO m) =>
Name -> m Profile
load Name
name ExceptT LoadError m Profile
-> (ExceptT LoadError m Profile -> m (Either LoadError Profile))
-> m (Either LoadError Profile)
forall a b. a -> (a -> b) -> b
& ExceptT LoadError m Profile -> m (Either LoadError Profile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT m (Either LoadError Profile)
-> (Either LoadError Profile -> m (Maybe Profile))
-> m (Maybe Profile)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left LoadError
error -> do
        Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ LoadError -> Text
showLoadError LoadError
error
        Maybe Profile -> m (Maybe Profile)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
forall a. Maybe a
Nothing
      Right Profile
profile -> Maybe Profile -> m (Maybe Profile)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Profile -> m (Maybe Profile))
-> Maybe Profile -> m (Maybe Profile)
forall a b. (a -> b) -> a -> b
$ Profile -> Maybe Profile
forall a. a -> Maybe a
Just Profile
profile
  if Bool
shouldFilterDangling
    then do
      Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info Text
"Filter Dangling profiles"
      [Profile] -> m [Profile]
filterDangling [Profile]
profiles
    else [Profile] -> m [Profile]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Profile]
profiles
  where
    filterDangling :: [Profile] -> m [Profile]
    filterDangling :: [Profile] -> m [Profile]
filterDangling = (Profile -> m Bool) -> [Profile] -> m [Profile]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM \Profile {Name
name :: Name
name :: Profile -> Name
name, State
state :: State
state :: Profile -> State
state} ->
      case State
state of
        State
Dangling -> do
          Text -> m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Found Dangling 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
"\""
          Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        State
Valid -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

showListError :: ListError -> Text
showListError :: ListError -> Text
showListError = \case
  ProfilesHomeDirDoesNotExistError Absolute
path
    -> Text
"Profiles home directory " 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
" does not exist."
  ListDirectoryError Absolute
path IOException
cause
    -> Text
"Unable to list profiles home directory " 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 'list'.
--
-- @since 0.1.0.0
data ListError
  = ProfilesHomeDirDoesNotExistError !Path.Absolute
  -- ^ 'PFile.Env.profilesHomeDirPath' does not exist.
  | ListDirectoryError !Path.Absolute !IOException
  -- ^ 'IOException' was encountered during directory listing.

-- | 'list' options.
--
-- @since 0.1.0.0
newtype ListOptions
  = ListOptions
      { ListOptions -> Bool
shouldFilterDangling :: Bool
      -- ^ Whether 'list' should filter out
      -- 'PFile.Profile.Internal.Profile.Dangling' profiles.
      }