module HMGit.Commands.Plumbing.LsFiles.Core (
    LsFiles (..)
  , LsFilesCfg (..)
  , lsFilesShow
  , lsFilesDetail
) where

import           HMGit.Internal.Core             (loadIndex)
import           HMGit.Internal.Core.Runner      (HMGitT)
import           HMGit.Internal.Parser           (IndexEntry (..))
import           HMGit.Internal.Parser.Pathspecs (pathspecs)
import           HMGit.Internal.Utils            (hexStr)

import           Control.Applicative             (Alternative (..))
import           Control.Exception.Safe          (MonadCatch, catchAny)
import           Control.Monad.IO.Class          (MonadIO (..))
import           Data.Bits                       (shiftL, (.&.))
import qualified Path                            as P
import qualified Path.IO                         as P
import           Text.Printf                     (printf)

newtype LsFiles m = LsFiles { LsFiles m -> LsFilesCfg -> HMGitT m ()
lsFiles :: LsFilesCfg -> HMGitT m () }

newtype LsFilesCfg = LsFilesCfg {
    LsFilesCfg -> [String]
lsFilesPathspecs :: [String]
  }

putLs :: MonadIO m
    => IndexEntry
    -> FilePath
    -> HMGitT m ()
putLs :: IndexEntry -> String -> HMGitT m ()
putLs IndexEntry
_ String
fp = IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HMGitT m ()) -> IO () -> HMGitT m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
fp

putLsDetail :: MonadIO m
    => IndexEntry
    -> FilePath
    -> HMGitT m ()
putLsDetail :: IndexEntry -> String -> HMGitT m ()
putLsDetail IndexEntry
idx String
fp = IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO () -> HMGitT m ()) -> IO () -> HMGitT m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn
    (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> String -> Word16 -> String -> String
forall r. PrintfType r => String -> r
printf String
"%6o %s %d\t%s"
        (IndexEntry -> Word32
ieMode IndexEntry
idx)
        (ByteString -> String
forall mono.
(MonoFoldable mono, PrintfArg (Element mono)) =>
mono -> String
hexStr (IndexEntry -> ByteString
ieSha1 IndexEntry
idx))
        ((IndexEntry -> Word16
ieFlags IndexEntry
idx Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
12) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
3)
        String
fp

lsFilesBase :: (MonadCatch m, MonadIO m, Alternative m)
    => (IndexEntry -> FilePath -> HMGitT m ())
    -> LsFiles m
lsFilesBase :: (IndexEntry -> String -> HMGitT m ()) -> LsFiles m
lsFilesBase IndexEntry -> String -> HMGitT m ()
printer = (LsFilesCfg -> HMGitT m ()) -> LsFiles m
forall (m :: * -> *). (LsFilesCfg -> HMGitT m ()) -> LsFiles m
LsFiles ((LsFilesCfg -> HMGitT m ()) -> LsFiles m)
-> (LsFilesCfg -> HMGitT m ()) -> LsFiles m
forall a b. (a -> b) -> a -> b
$ \LsFilesCfg
lsFilesCfg ->
    let pat' :: [String]
pat' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LsFilesCfg -> [String]
lsFilesPathspecs LsFilesCfg
lsFilesCfg)
        then [String
"."]
        else LsFilesCfg -> [String]
lsFilesPathspecs LsFilesCfg
lsFilesCfg in do
        Path Abs Dir
cDir <- ReaderT HMGitConfig m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
P.getCurrentDir
        HMGitT m [IndexEntry]
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
HMGitT m [IndexEntry]
loadIndex
            HMGitT m [IndexEntry]
-> ([IndexEntry] -> HMGitT m ()) -> HMGitT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IndexEntry -> HMGitT m ()) -> [IndexEntry] -> HMGitT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\IndexEntry
e ->
                (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 (IndexEntry -> Path Rel File
iePath IndexEntry
e)) [String]
pat'
                    HMGitT m String -> (String -> HMGitT m ()) -> HMGitT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IndexEntry -> String -> HMGitT m ()
printer IndexEntry
e) HMGitT m () -> (SomeException -> HMGitT m ()) -> HMGitT m ()
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchAny` HMGitT m () -> SomeException -> HMGitT m ()
forall a b. a -> b -> a
const (() -> HMGitT m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

lsFilesShow :: (MonadCatch m, MonadIO m, Alternative m) => LsFiles m
lsFilesShow :: LsFiles m
lsFilesShow = (IndexEntry -> String -> HMGitT m ()) -> LsFiles m
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
(IndexEntry -> String -> HMGitT m ()) -> LsFiles m
lsFilesBase IndexEntry -> String -> HMGitT m ()
forall (m :: * -> *).
MonadIO m =>
IndexEntry -> String -> HMGitT m ()
putLs

lsFilesDetail :: (MonadCatch m, MonadIO m, Alternative m) => LsFiles m
lsFilesDetail :: LsFiles m
lsFilesDetail = (IndexEntry -> String -> HMGitT m ()) -> LsFiles m
forall (m :: * -> *).
(MonadCatch m, MonadIO m, Alternative m) =>
(IndexEntry -> String -> HMGitT m ()) -> LsFiles m
lsFilesBase IndexEntry -> String -> HMGitT m ()
forall (m :: * -> *).
MonadIO m =>
IndexEntry -> String -> HMGitT m ()
putLsDetail