{- |
Module:      PFile.Main.New
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)

Main for `pfile new`.
-}

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

module PFile.Main.New
  ( main
  ) where

import qualified Data.List     as List
import           PFile.CLI.New (Options (..))
import           PFile.Env     (Env)
import           PFile.Error   (modifyError)
import qualified PFile.Log     as Log
import qualified PFile.Path    as Path
import qualified PFile.Profile as Profile
import           Protolude

main :: (MonadReader Env m, MonadIO m) => Options -> m ()
main :: forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Options -> m ()
main Options {Strategy
linkHandlingStrategy :: Strategy
linkHandlingStrategy :: Options -> Strategy
linkHandlingStrategy, Text
profileName :: Text
profileName :: Options -> Text
profileName, [FilePath]
paths :: [FilePath]
paths :: Options -> [FilePath]
paths} = do
  [Absolute]
parsedPaths <- (FilePath -> m (Maybe Absolute))
-> [FilePath] -> m [Maybe Absolute]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> m (Maybe Absolute)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe Absolute)
Path.parseAbsolute [FilePath]
paths m [Maybe Absolute]
-> ([Maybe Absolute] -> m [Absolute]) -> m [Absolute]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> [Maybe Absolute] -> m [Absolute]
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
[FilePath] -> [Maybe Absolute] -> m [Absolute]
ensureAllPathsParsed [FilePath]
paths
  (Text -> m ()) -> (() -> m ()) -> Either Text () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> m ()
forall (m :: * -> *) a. MonadIO m => Text -> m a
Log.panic () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> m ())
-> (ExceptT Text m () -> m (Either Text ()))
-> ExceptT Text m ()
-> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ExceptT Text m () -> m (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m () -> m ()) -> ExceptT Text m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CreateOptions
-> Name
-> [Absolute]
-> ExceptT CreateError (ExceptT Text m) Profile
forall (m :: * -> *).
(MonadReader Env m, MonadError CreateError m, MonadIO m) =>
CreateOptions -> Name -> [Absolute] -> m Profile
Profile.create CreateOptions
createOptions (Text -> Name
Profile.Name Text
profileName) [Absolute]
parsedPaths
      ExceptT CreateError (ExceptT Text m) Profile
-> (ExceptT CreateError (ExceptT Text m) Profile
    -> ExceptT Text m Profile)
-> ExceptT Text m Profile
forall a b. a -> (a -> b) -> b
& (CreateError -> Text)
-> ExceptT CreateError (ExceptT Text m) Profile
-> ExceptT Text m Profile
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateError -> Text
Profile.showCreateError
      ExceptT Text m Profile
-> (ExceptT Text m Profile -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& ExceptT Text m Profile -> ExceptT Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    ExceptT LoadCurrentError (ExceptT Text m) Profile
forall (m :: * -> *).
(MonadReader Env m, MonadError LoadCurrentError m, MonadIO m) =>
m Profile
Profile.loadCurrent ExceptT LoadCurrentError (ExceptT Text m) Profile
-> (ExceptT LoadCurrentError (ExceptT Text m) Profile
    -> ExceptT Text m (Either LoadCurrentError Profile))
-> ExceptT Text m (Either LoadCurrentError Profile)
forall a b. a -> (a -> b) -> b
& ExceptT LoadCurrentError (ExceptT Text m) Profile
-> ExceptT Text m (Either LoadCurrentError Profile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT Text m (Either LoadCurrentError Profile)
-> (Either LoadCurrentError Profile -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b.
ExceptT Text m a -> (a -> ExceptT Text m b) -> ExceptT Text m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left LoadCurrentError
error -> Text -> ExceptT Text m ()
forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
Text -> m ()
Log.info (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ LoadCurrentError -> Text
Profile.showLoadCurrentError LoadCurrentError
error
      Right Profile
currentProfile ->
        SwitchOptions -> Profile -> ExceptT LinkError (ExceptT Text m) ()
forall (m :: * -> *).
(MonadError LinkError m, MonadIO m) =>
SwitchOptions -> Profile -> m ()
Profile.link SwitchOptions
switchOptions Profile
currentProfile
          ExceptT LinkError (ExceptT Text m) ()
-> (ExceptT LinkError (ExceptT Text m) () -> ExceptT Text m ())
-> ExceptT Text m ()
forall a b. a -> (a -> b) -> b
& (LinkError -> Text)
-> ExceptT LinkError (ExceptT Text m) () -> ExceptT Text m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError LinkError -> Text
Profile.showLinkError
  where
    createOptions :: Profile.CreateOptions
    createOptions :: CreateOptions
createOptions = Profile.CreateOptions {Strategy
linkHandlingStrategy :: Strategy
linkHandlingStrategy :: Strategy
Profile.linkHandlingStrategy}

    switchOptions :: Profile.SwitchOptions
    switchOptions :: SwitchOptions
switchOptions = Profile.SwitchOptions {forceRemoveOccupied :: Bool
Profile.forceRemoveOccupied = Bool
True}

ensureAllPathsParsed ::
     forall m. (MonadReader Env m, MonadIO m)
  => [FilePath]
  -> [Maybe Path.Absolute]
  -> m [Path.Absolute]
ensureAllPathsParsed :: forall (m :: * -> *).
(MonadReader Env m, MonadIO m) =>
[FilePath] -> [Maybe Absolute] -> m [Absolute]
ensureAllPathsParsed [FilePath]
inputPaths [Maybe Absolute]
maybeParsedPaths = do
  ([FilePath]
unparsed, [Absolute]
parsed) <- (([FilePath], [Absolute])
 -> (FilePath, Maybe Absolute) -> m ([FilePath], [Absolute]))
-> ([FilePath], [Absolute])
-> [(FilePath, Maybe Absolute)]
-> m ([FilePath], [Absolute])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ([FilePath], [Absolute])
-> (FilePath, Maybe Absolute) -> m ([FilePath], [Absolute])
go ([], []) ([(FilePath, Maybe Absolute)] -> m ([FilePath], [Absolute]))
-> [(FilePath, Maybe Absolute)] -> m ([FilePath], [Absolute])
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [Maybe Absolute] -> [(FilePath, Maybe Absolute)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
inputPaths [Maybe Absolute]
maybeParsedPaths
  if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [FilePath]
unparsed
    then [Absolute] -> m [Absolute]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Absolute]
parsed
    else Text -> m [Absolute]
forall (m :: * -> *) a. MonadIO m => Text -> m a
Log.panic Text
"Invalid input paths provided."
  where
    go ::
         ([FilePath], [Path.Absolute])
      -> (FilePath, Maybe Path.Absolute)
      -> m ([FilePath], [Path.Absolute])
    go :: ([FilePath], [Absolute])
-> (FilePath, Maybe Absolute) -> m ([FilePath], [Absolute])
go ([FilePath]
unparsed, [Absolute]
parsed) (FilePath
inputPath, Maybe Absolute
maybeParsedPath) =
      case Maybe Absolute
maybeParsedPath of
        Maybe Absolute
Nothing -> do
          Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
Log.error (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Unable to parse path: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
inputPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
          ([FilePath], [Absolute]) -> m ([FilePath], [Absolute])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
inputPath FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
unparsed, [Absolute]
parsed)
        Just Absolute
parsedPath -> 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
"Parsed input path \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
inputPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
parsedPath
          ([FilePath], [Absolute]) -> m ([FilePath], [Absolute])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath]
unparsed, Absolute
parsedPath Absolute -> [Absolute] -> [Absolute]
forall a. a -> [a] -> [a]
: [Absolute]
parsed)