{-# LANGUAGE CPP, OverloadedStrings #-}
module HMGit.Commands.Plumbing.CatFile.Core (
    CatFile (..)
  , catOptObject
  , catOptObjectType
  , catOptObjectSize
  , catOptObjectPP
  , catFile
) where

import           HMGit.Internal.Core        (loadObject, loadTree)
import           HMGit.Internal.Core.Runner (HMGitT)
import           HMGit.Internal.Exceptions
import           HMGit.Internal.Parser
import           Text.Printf                (printf)

import           Control.Exception.Safe     (MonadCatch, MonadThrow, throw)
import           Control.Monad              (MonadPlus)
import           Control.Monad.IO.Class     (MonadIO (..))
import qualified Data.ByteString.Lazy       as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import           Data.String                (IsString (..))
import qualified Path                       as P
import           Prelude                    hiding (init)
import           System.Posix.Types         (CMode (..))
#ifndef mingw32_HOST_OS
import           System.Posix.Internals     (s_isdir)
sIsDir :: CMode -> Bool
sIsDir :: CMode -> Bool
sIsDir = CMode -> Bool
s_isdir
#else
import           Data.Bits                  ((.&.))
sIsDir :: CMode -> Bool
sIsDir = (== sIFDIR) . (.&. sIFMT)
    where
        sIFMT = 0o170000
        sIFDIR = 0o040000
#endif

data CatFile m = CatFileObjectType ObjectType (ObjectType -> BL.ByteString -> HMGitT m ())
    | CatFileMode (ObjectType -> BL.ByteString -> HMGitT m ())

instance MonadIO m => IsString (CatFile m) where
    fromString :: String -> CatFile m
fromString = ObjectType -> CatFile m
forall (m :: * -> *). MonadIO m => ObjectType -> CatFile m
catOptObject (ObjectType -> CatFile m)
-> (String -> ObjectType) -> String -> CatFile m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ObjectType
forall a. Read a => String -> a
read

catOptObject :: MonadIO m => ObjectType -> CatFile m
catOptObject :: ObjectType -> CatFile m
catOptObject = (ObjectType
 -> (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m)
-> (ObjectType -> ByteString -> HMGitT m ())
-> ObjectType
-> CatFile m
forall a b c. (a -> b -> c) -> b -> a -> c
flip ObjectType
-> (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall (m :: * -> *).
ObjectType
-> (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
CatFileObjectType ((ObjectType -> ByteString -> HMGitT m ())
 -> ObjectType -> CatFile m)
-> (ObjectType -> ByteString -> HMGitT m ())
-> ObjectType
-> CatFile m
forall a b. (a -> b) -> a -> b
$ (ByteString -> HMGitT m ())
-> ObjectType -> ByteString -> HMGitT m ()
forall a b. a -> b -> a
const (IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HMGitT m ())
-> (ByteString -> IO ()) -> ByteString -> HMGitT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
BLC.putStr)

catOptObjectType :: MonadIO m => CatFile m
catOptObjectType :: CatFile m
catOptObjectType = (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall (m :: * -> *).
(ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
CatFileMode ((ObjectType -> ByteString -> HMGitT m ()) -> CatFile m)
-> (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall a b. (a -> b) -> a -> b
$ HMGitT m () -> ByteString -> HMGitT m ()
forall a b. a -> b -> a
const (HMGitT m () -> ByteString -> HMGitT m ())
-> (ObjectType -> HMGitT m ())
-> ObjectType
-> ByteString
-> HMGitT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HMGitT m ())
-> (ObjectType -> IO ()) -> ObjectType -> HMGitT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> IO ()
forall a. Show a => a -> IO ()
print

catOptObjectSize :: MonadIO m => CatFile m
catOptObjectSize :: CatFile m
catOptObjectSize = (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall (m :: * -> *).
(ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
CatFileMode ((ObjectType -> ByteString -> HMGitT m ()) -> CatFile m)
-> (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall a b. (a -> b) -> a -> b
$ (ByteString -> HMGitT m ())
-> ObjectType -> ByteString -> HMGitT m ()
forall a b. a -> b -> a
const ((ByteString -> HMGitT m ())
 -> ObjectType -> ByteString -> HMGitT m ())
-> (ByteString -> HMGitT m ())
-> ObjectType
-> ByteString
-> HMGitT m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HMGitT m ())
-> (ByteString -> IO ()) -> ByteString -> HMGitT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IO ()
forall a. Show a => a -> IO ()
print (Int64 -> IO ()) -> (ByteString -> Int64) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length

catOptObjectPP :: (MonadIO m, MonadThrow m) => CatFile m
catOptObjectPP :: CatFile m
catOptObjectPP = (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall (m :: * -> *).
(ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
CatFileMode ((ObjectType -> ByteString -> HMGitT m ()) -> CatFile m)
-> (ObjectType -> ByteString -> HMGitT m ()) -> CatFile m
forall a b. (a -> b) -> a -> b
$ \ObjectType
objType ByteString
body ->
    if ObjectType
objType ObjectType -> [ObjectType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ ObjectType
Commit, ObjectType
Blob ] then IO () -> HMGitT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO ()
BLC.putStr ByteString
body)
    else ByteString -> HMGitT m [(CMode, Path Rel File, String)]
forall (m :: * -> *).
MonadThrow m =>
ByteString -> HMGitT m [(CMode, Path Rel File, String)]
loadTree ByteString
body
        HMGitT m [(CMode, Path Rel File, String)]
-> ([(CMode, Path Rel File, String)] -> HMGitT m ()) -> HMGitT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((CMode, Path Rel File, String) -> HMGitT m ())
-> [(CMode, Path Rel File, String)] -> HMGitT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(CMode
mode, Path Rel File
fpath, String
sha1) ->
            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] -> String
unwords [
                String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%06o" (CMode -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CMode
mode :: Integer)
              , if CMode -> Bool
sIsDir CMode
mode then String
"tree" else String
"blob"
              , String
sha1
              ] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"\t%s" (Path Rel File -> String
forall b t. Path b t -> String
P.toFilePath Path Rel File
fpath))

catFile :: (MonadIO m, MonadCatch m, MonadPlus m)
    => CatFile m
    -> String
    -> HMGitT m ()
catFile :: CatFile m -> String -> HMGitT m ()
catFile CatFile m
catOpt String
sha1 = do
    (ObjectType
objType, ByteString
body) <- String -> HMGitT m (ObjectType, ByteString)
forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadPlus m) =>
String -> HMGitT m (ObjectType, ByteString)
loadObject String
sha1
    case CatFile m
catOpt of
        CatFileObjectType ObjectType
specifiedObjType ObjectType -> ByteString -> HMGitT m ()
f
            | ObjectType
specifiedObjType ObjectType -> ObjectType -> Bool
forall a. Eq a => a -> a -> Bool
/= ObjectType
objType -> IOError -> HMGitT m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw
                (IOError -> HMGitT m ()) -> IOError -> HMGitT m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
invalidArgument
                (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [
                    String
"expected object type"
                  , ObjectType -> String
forall a. Show a => a -> String
show ObjectType
specifiedObjType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
","
                  , String
"but got"
                  , ObjectType -> String
forall a. Show a => a -> String
show ObjectType
objType
                  ]
            | Bool
otherwise -> ObjectType -> ByteString -> HMGitT m ()
f ObjectType
objType ByteString
body
        CatFileMode ObjectType -> ByteString -> HMGitT m ()
f -> ObjectType -> ByteString -> HMGitT m ()
f ObjectType
objType ByteString
body