{-# LANGUAGE LambdaCase, TupleSections #-}
module HMGit.Commands.Porcelain.Status.Core (
    Status (..)
  , StatusCfg (..)
  , statusDefault
  , statusShort
) where

import           HMGit.Internal.Core             (HMGitStatus (..), getStatus)
import           HMGit.Internal.Core.Runner      (HMGitT)
import           HMGit.Internal.Parser.Pathspecs (pathspecs)

import           Control.Applicative             (Alternative (..))
import           Control.Exception.Safe          (MonadCatch, catchAny)
import           Control.Monad                   (foldM, zipWithM_, (>=>))
import           Control.Monad.IO.Class          (MonadIO (..))
import           Control.Monad.Trans             (lift)
import           Control.Monad.Trans.Reader      (ReaderT (..), ask)
import           Data.Functor                    ((<&>))
import qualified Data.List.NonEmpty              as LN
import qualified Data.Set                        as S
import qualified Path                            as P
import qualified Path.IO                         as P
import           Text.Printf                     (printf)

newtype Status m = Status { Status m -> StatusCfg -> HMGitT m ()
status :: StatusCfg -> HMGitT m () }

newtype StatusCfg = StatusCfg {
    StatusCfg -> [String]
statusPathspecs :: [String]
  }

type StatusSelector = HMGitStatus -> S.Set (P.Path P.Rel P.File)

type StatusShow m = ReaderT (HMGitStatus, [String], P.Path P.Abs P.Dir, String -> IO ()) (HMGitT m)

statusShow :: (MonadIO m, MonadCatch m, Alternative m)
    => StatusSelector
    -> String
    -> StatusShow m ()
statusShow :: StatusSelector -> String -> StatusShow m ()
statusShow StatusSelector
sctor String
title = do
    (HMGitStatus
hs, [String]
pats, Path Abs Dir
cDir, String -> IO ()
printer) <- ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    ([String]
 -> Path Rel File
 -> ReaderT
      (HMGitStatus, [String], Path Abs Dir, String -> IO ())
      (HMGitT m)
      [String])
-> [String]
-> [Path Rel File]
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     [String]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\[String]
acc Path Rel File
p -> ReaderT HMGitConfig m [String]
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Path Abs Dir -> SomeBase File -> [String] -> HMGitT m String
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
Path Abs Dir -> SomeBase File -> [String] -> HMGitT m String
pathspecs Path Abs Dir
cDir (Path Rel File -> SomeBase File
forall t. Path Rel t -> SomeBase t
P.Rel Path Rel File
p) [String]
pats HMGitT m String
-> (String -> [String]) -> ReaderT HMGitConfig m [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc)) ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  [String]
-> (SomeException
    -> ReaderT
         (HMGitStatus, [String], Path Abs Dir, String -> IO ())
         (HMGitT m)
         [String])
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     [String]
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchAny` ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  [String]
-> SomeException
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     [String]
forall a b. a -> b -> a
const ([String]
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
acc))
        [String]
forall a. Monoid a => a
mempty
        (Set (Path Rel File) -> [Path Rel File]
forall a. Set a -> [a]
S.toList (StatusSelector
sctor HMGitStatus
hs))
        ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  [String]
-> ([String] -> Maybe (NonEmpty String))
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     (Maybe (NonEmpty String))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
LN.nonEmpty
        ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  (Maybe (NonEmpty String))
-> (Maybe (NonEmpty String) -> StatusShow m ()) -> StatusShow m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe (NonEmpty String)
Nothing -> () -> StatusShow m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just NonEmpty String
fs -> IO () -> StatusShow m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStr String
title)
                StatusShow m () -> StatusShow m () -> StatusShow m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> StatusShow m ()) -> NonEmpty String -> StatusShow m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> StatusShow m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StatusShow m ())
-> (String -> IO ()) -> String -> StatusShow m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
printer) NonEmpty String
fs

statusDefault :: (MonadIO m, MonadCatch m, Alternative m) => Status m
statusDefault :: Status m
statusDefault = (StatusCfg -> HMGitT m ()) -> Status m
forall (m :: * -> *). (StatusCfg -> HMGitT m ()) -> Status m
Status ([String]
-> ReaderT
     HMGitConfig
     m
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
forall a (m :: * -> *) (m :: * -> *) t.
(PrintfArg a, MonadIO m, MonadIO m, MonadCatch m) =>
t
-> ReaderT HMGitConfig m (HMGitStatus, t, Path Abs Dir, a -> m ())
cfg ([String]
 -> ReaderT
      HMGitConfig
      m
      (HMGitStatus, [String], Path Abs Dir, String -> IO ()))
-> (StatusCfg -> [String])
-> StatusCfg
-> ReaderT
     HMGitConfig
     m
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusCfg -> [String]
statusPathspecs (StatusCfg
 -> ReaderT
      HMGitConfig
      m
      (HMGitStatus, [String], Path Abs Dir, String -> IO ()))
-> ((HMGitStatus, [String], Path Abs Dir, String -> IO ())
    -> HMGitT m ())
-> StatusCfg
-> HMGitT m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  ()
-> (HMGitStatus, [String], Path Abs Dir, String -> IO ())
-> HMGitT m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  ()
statusShow')
    where
        cfg :: t
-> ReaderT HMGitConfig m (HMGitStatus, t, Path Abs Dir, a -> m ())
cfg t
pats = (, t
pats, , IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> String
forall r. PrintfType r => String -> r
printf String
"\t%s")
            (HMGitStatus
 -> Path Abs Dir -> (HMGitStatus, t, Path Abs Dir, a -> m ()))
-> ReaderT HMGitConfig m HMGitStatus
-> ReaderT
     HMGitConfig
     m
     (Path Abs Dir -> (HMGitStatus, t, Path Abs Dir, a -> m ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT HMGitConfig m HMGitStatus
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
HMGitT m HMGitStatus
getStatus
            ReaderT
  HMGitConfig
  m
  (Path Abs Dir -> (HMGitStatus, t, Path Abs Dir, a -> m ()))
-> ReaderT HMGitConfig m (Path Abs Dir)
-> ReaderT HMGitConfig m (HMGitStatus, t, Path Abs Dir, a -> m ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT HMGitConfig m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
P.getCurrentDir
        statusShow' :: ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  ()
statusShow' = (StatusSelector
 -> String
 -> ReaderT
      (HMGitStatus, [String], Path Abs Dir, String -> IO ())
      (HMGitT m)
      ())
-> [StatusSelector]
-> [String]
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ StatusSelector
-> String
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m, Alternative m) =>
StatusSelector -> String -> StatusShow m ()
statusShow
            [ StatusSelector
statusChanged, StatusSelector
statusNew, StatusSelector
statusDeleted ]
            [ String
"Changes files:\n", String
"New files:\n", String
"Deleted files:\n" ]

statusShort :: (MonadCatch m, MonadIO m, Alternative m) => Status m
statusShort :: Status m
statusShort = (StatusCfg -> HMGitT m ()) -> Status m
forall (m :: * -> *). (StatusCfg -> HMGitT m ()) -> Status m
Status ((StatusCfg -> HMGitT m ()) -> Status m)
-> (StatusCfg -> HMGitT m ()) -> Status m
forall a b. (a -> b) -> a -> b
$ \StatusCfg
statusCfg -> do
    Path Abs Dir
cDir <- ReaderT HMGitConfig m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
P.getCurrentDir
    HMGitStatus
st <- HMGitT m HMGitStatus
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
HMGitT m HMGitStatus
getStatus
    (StatusSelector
 -> (HMGitStatus, [String], Path Abs Dir, String -> IO ())
 -> HMGitT m ())
-> [StatusSelector]
-> [(HMGitStatus, [String], Path Abs Dir, String -> IO ())]
-> HMGitT m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\StatusSelector
x -> ReaderT
  (HMGitStatus, [String], Path Abs Dir, String -> IO ())
  (HMGitT m)
  ()
-> (HMGitStatus, [String], Path Abs Dir, String -> IO ())
-> HMGitT m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StatusSelector
-> String
-> ReaderT
     (HMGitStatus, [String], Path Abs Dir, String -> IO ())
     (HMGitT m)
     ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m, Alternative m) =>
StatusSelector -> String -> StatusShow m ()
statusShow StatusSelector
x String
""))
        [ StatusSelector
statusChanged
        , StatusSelector
statusNew
        , StatusSelector
statusDeleted
        ]
        [ (HMGitStatus
st, StatusCfg -> [String]
statusPathspecs StatusCfg
statusCfg, Path Abs Dir
cDir, String -> IO ()
putStrLn (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
" M %s")
        , (HMGitStatus
st, StatusCfg -> [String]
statusPathspecs StatusCfg
statusCfg, Path Abs Dir
cDir, String -> IO ()
putStrLn (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
"?? %s")
        , (HMGitStatus
st, StatusCfg -> [String]
statusPathspecs StatusCfg
statusCfg, Path Abs Dir
cDir, String -> IO ()
putStrLn (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
" D %s")
        ]