{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Linters.Common where

-- base
import           Control.Monad
  ( liftM, unless )
import           Data.Function
  ( on )
import           Data.List
  ( groupBy )
import           Data.Maybe
  ( fromMaybe )
import           GHC.IO.Encoding
  ( utf8, setLocaleEncoding, getLocaleEncoding, textEncodingName )

-- deepseq
import           Control.DeepSeq
  ( NFData(rnf), force, ($!!) )

-- process
import System.Process
  ( readProcess )

-- text
import           Data.Text
  ( Text )
import qualified Data.Text as T

--------------------------------------------------------------------------------

data LintMsg = LintMsg !LintLvl !Int !Text !Text
              deriving stock Int -> LintMsg -> ShowS
[LintMsg] -> ShowS
LintMsg -> [Char]
(Int -> LintMsg -> ShowS)
-> (LintMsg -> [Char]) -> ([LintMsg] -> ShowS) -> Show LintMsg
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LintMsg -> ShowS
showsPrec :: Int -> LintMsg -> ShowS
$cshow :: LintMsg -> [Char]
show :: LintMsg -> [Char]
$cshowList :: [LintMsg] -> ShowS
showList :: [LintMsg] -> ShowS
Show

data LintLvl = LintLvlWarn | LintLvlErr
              deriving stock ( Int -> LintLvl -> ShowS
[LintLvl] -> ShowS
LintLvl -> [Char]
(Int -> LintLvl -> ShowS)
-> (LintLvl -> [Char]) -> ([LintLvl] -> ShowS) -> Show LintLvl
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LintLvl -> ShowS
showsPrec :: Int -> LintLvl -> ShowS
$cshow :: LintLvl -> [Char]
show :: LintLvl -> [Char]
$cshowList :: [LintLvl] -> ShowS
showList :: [LintLvl] -> ShowS
Show, LintLvl -> LintLvl -> Bool
(LintLvl -> LintLvl -> Bool)
-> (LintLvl -> LintLvl -> Bool) -> Eq LintLvl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LintLvl -> LintLvl -> Bool
== :: LintLvl -> LintLvl -> Bool
$c/= :: LintLvl -> LintLvl -> Bool
/= :: LintLvl -> LintLvl -> Bool
Eq, Eq LintLvl
Eq LintLvl
-> (LintLvl -> LintLvl -> Ordering)
-> (LintLvl -> LintLvl -> Bool)
-> (LintLvl -> LintLvl -> Bool)
-> (LintLvl -> LintLvl -> Bool)
-> (LintLvl -> LintLvl -> Bool)
-> (LintLvl -> LintLvl -> LintLvl)
-> (LintLvl -> LintLvl -> LintLvl)
-> Ord LintLvl
LintLvl -> LintLvl -> Bool
LintLvl -> LintLvl -> Ordering
LintLvl -> LintLvl -> LintLvl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LintLvl -> LintLvl -> Ordering
compare :: LintLvl -> LintLvl -> Ordering
$c< :: LintLvl -> LintLvl -> Bool
< :: LintLvl -> LintLvl -> Bool
$c<= :: LintLvl -> LintLvl -> Bool
<= :: LintLvl -> LintLvl -> Bool
$c> :: LintLvl -> LintLvl -> Bool
> :: LintLvl -> LintLvl -> Bool
$c>= :: LintLvl -> LintLvl -> Bool
>= :: LintLvl -> LintLvl -> Bool
$cmax :: LintLvl -> LintLvl -> LintLvl
max :: LintLvl -> LintLvl -> LintLvl
$cmin :: LintLvl -> LintLvl -> LintLvl
min :: LintLvl -> LintLvl -> LintLvl
Ord )

type GitRef = Text

type Sh = IO

silently :: a -> a
silently :: forall a. a -> a
silently = a -> a
forall a. a -> a
id

runGit :: FilePath -> Text -> [Text] -> Sh Text
runGit :: [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
fp Text
t [Text]
ts = [Char] -> Text -> [Text] -> Text -> Sh Text
runGitStdin [Char]
fp Text
t [Text]
ts Text
""

-- | Run @git@ operation
runGitStdin :: FilePath -> Text -> [Text] -> Text -> Sh Text
runGitStdin :: [Char] -> Text -> [Text] -> Text -> Sh Text
runGitStdin [Char]
d Text
op [Text]
args Text
std_in = do
    Text
d' <- Text -> Sh Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Sh Text) -> Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
d
    [Char]
out <- Sh [Char] -> Sh [Char]
forall a. Sh a -> Sh a
withUtf8 (Sh [Char] -> Sh [Char]) -> Sh [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ Sh [Char] -> Sh [Char]
forall a. a -> a
silently (Sh [Char] -> Sh [Char]) -> Sh [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char] -> Sh [Char]
readProcess [Char]
"git" ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack (Text
"-C" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
d' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
op Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)) (Text -> [Char]
T.unpack Text
std_in)
    Text -> Sh Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Text
T.pack [Char]
out)

-- | WARNING: non-reentrant Hack!
withUtf8 :: Sh a -> Sh a
withUtf8 :: forall a. Sh a -> Sh a
withUtf8 Sh a
act = do
    TextEncoding
oldloc <- IO TextEncoding
getLocaleEncoding
    if (TextEncoding -> [Char]
textEncodingName TextEncoding
oldloc [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== TextEncoding -> [Char]
textEncodingName TextEncoding
utf8)
    then Sh a
act
    else do
        TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
        a
r <- Sh a
act
        TextEncoding -> IO ()
setLocaleEncoding TextEncoding
oldloc
        a -> Sh a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | wrapper around @git cat-file commit@
--
-- Returns (commit-header, commit-body)
gitCatCommit :: FilePath -> GitRef -> Sh (Text,Text)
gitCatCommit :: [Char] -> Text -> Sh (Text, Text)
gitCatCommit [Char]
d Text
ref = do
    Text
tmp <- [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"cat-file" [Text
"commit", Text
ref ]
    (Text, Text) -> Sh (Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.drop Int
2) ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"\n\n" Text
tmp)

-- | wrapper around @git cat-file commit@
gitCatBlob :: FilePath -> GitRef -> Sh Text
gitCatBlob :: [Char] -> Text -> Sh Text
gitCatBlob [Char]
d Text
ref = do
    Int
tmpl <- (Text -> Int) -> Sh Text -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Int
tread (Sh Text -> IO Int) -> Sh Text -> IO Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"cat-file" [Text
"-s", Text
ref] -- workaround shelly adding EOLs
    Text
tmp <- [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"cat-file" [Text
"blob", Text
ref]
    Text -> Sh Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Text -> Text
T.take Int
tmpl Text
tmp)
  where
    tread :: Text -> Int
tread = [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> (Text -> [Char]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- | Wrapper around @git rev-parse --verify@
--
-- Normalise git ref to commit sha1
gitNormCid :: FilePath -> GitRef -> Sh GitRef
gitNormCid :: [Char] -> Text -> Sh Text
gitNormCid [Char]
d Text
ref = do
    Text
tmp <- [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"rev-parse" [Text
"-q", Text
"--verify", Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^{commit}" ]
    Text -> Sh Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.strip Text
tmp)

-- | wrapper around @git branch --contains@
gitBranchesContain :: FilePath -> GitRef -> Sh [Text]
gitBranchesContain :: [Char] -> Text -> Sh [Text]
gitBranchesContain [Char]
d Text
ref = do
    [Text]
tmp <- (Text -> [Text]) -> Sh Text -> Sh [Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> [Text]
T.lines (Sh Text -> Sh [Text]) -> Sh Text -> Sh [Text]
forall a b. (a -> b) -> a -> b
$
           --errExit False $ print_stderr False $
           [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"branch" [Text
"--contains", Text
ref, Text
"-r"]

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Text
s -> Int -> Text -> Text
T.take Int
2 Text
s Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"  ",Text
"* "]) [Text]
tmp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"gitBranchesContain: internal error"

    [Text] -> Sh [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Sh [Text]) -> [Text] -> Sh [Text]
forall a b. NFData a => (a -> b) -> a -> b
$!! (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
2) [Text]
tmp

-- | returns @[(path, (url, key))]@
--
-- may throw exception
getModules :: FilePath -> GitRef -> Sh [(Text, (Text, Text))]
getModules :: [Char] -> Text -> Sh [(Text, (Text, Text))]
getModules [Char]
d Text
ref = do
    Text
tmp <- [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"show" [Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":.gitmodules"]

    [Text]
res <- (Text -> [Text]) -> Sh Text -> Sh [Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> [Text]
T.lines (Sh Text -> Sh [Text]) -> Sh Text -> Sh [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> [Text] -> Text -> Sh Text
runGitStdin [Char]
d Text
"config" [ Text
"--file", Text
"/dev/stdin", Text
"-l" ] Text
tmp

    let ms :: [(Text, (Text, Text))]
ms  = [ (HasCallStack => Text -> Text
Text -> Text
T.tail Text
key1,(Text
key2, HasCallStack => Text -> Text
Text -> Text
T.tail Text
val))
              | Text
r <- [Text]
res, Text
"submodule." Text -> Text -> Bool
`T.isPrefixOf` Text
r
              , let (Text
key,Text
val) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') Text
r
              , let (Text
key',Text
key2) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"." Text
key
              , let (Text
_,Text
key1) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (HasCallStack => Text -> Text
Text -> Text
T.init Text
key')
              ]

        ms' :: [(Text, (Text, Text))]
ms' = [ (Text
path', (Text
url, Text
k))
              | es :: [(Text, (Text, Text))]
es@((Text
k,(Text, Text)
_):[(Text, (Text, Text))]
_) <- ((Text, (Text, Text)) -> (Text, (Text, Text)) -> Bool)
-> [(Text, (Text, Text))] -> [[(Text, (Text, Text))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> ((Text, (Text, Text)) -> Text)
-> (Text, (Text, Text))
-> (Text, (Text, Text))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, (Text, Text)) -> Text
forall a b. (a, b) -> a
fst) [(Text, (Text, Text))]
ms
              , let props :: [(Text, Text)]
props = ((Text, (Text, Text)) -> (Text, Text))
-> [(Text, (Text, Text))] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, Text)) -> (Text, Text)
forall a b. (a, b) -> b
snd [(Text, (Text, Text))]
es
              , let url :: Text
url = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"getModules1") (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"url" [(Text, Text)]
props)
              , let path' :: Text
path' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"getModules2") (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"path" [(Text, Text)]
props)
              ]

    [(Text, (Text, Text))] -> Sh [(Text, (Text, Text))]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, (Text, Text))] -> Sh [(Text, (Text, Text))])
-> [(Text, (Text, Text))] -> Sh [(Text, (Text, Text))]
forall a b. NFData a => (a -> b) -> a -> b
$!! [(Text, (Text, Text))]
ms'


{- |

Possible meanings of the 'Char' value:

 * Added (A),
 * Copied (C),
 * Deleted (D),
 * Modified (M),
 * Renamed (R),
 * have their type (i.e. regular file, symlink, submodule, ...) changed (T),
 * are Unmerged (U),
 * are Unknown (X),
 * or have had their pairing Broken (B).

-}
gitDiffTree :: FilePath -> GitRef -> Sh (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
gitDiffTree :: [Char]
-> Text
-> Sh (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
gitDiffTree [Char]
d Text
ref = do
    [Text]
tmp <- (Text -> [Text]) -> Sh Text -> Sh [Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> [Text]
T.lines (Sh Text -> Sh [Text]) -> Sh Text -> Sh [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"diff-tree" [Text
"--root",Text
"-c", Text
"-r", Text
ref]
    case [Text]
tmp of
        Text
cid:[Text]
deltas -> (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
-> Sh (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
 -> Sh (Text, [([(GitType, Text, Char)], (GitType, Text), Text)]))
-> (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
-> Sh (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
forall a b. NFData a => (a -> b) -> a -> b
$!! (Text
cid, (Text -> ([(GitType, Text, Char)], (GitType, Text), Text))
-> [Text] -> [([(GitType, Text, Char)], (GitType, Text), Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ([(GitType, Text, Char)], (GitType, Text), Text)
parseDtLine [Text]
deltas)
        []         -> (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
-> Sh (Text, [([(GitType, Text, Char)], (GitType, Text), Text)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", [])

  where
    parseDtLine :: Text -> ([(GitType, Text, Char)], (GitType, Text), Text)
    parseDtLine :: Text -> ([(GitType, Text, Char)], (GitType, Text), Text)
parseDtLine Text
l
      | Bool
sanityCheck = ([(GitType, Text, Char)], (GitType, Text), Text)
-> ([(GitType, Text, Char)], (GitType, Text), Text)
forall a. NFData a => a -> a
force ([GitType] -> [Text] -> [Char] -> [(GitType, Text, Char)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ((Text -> GitType) -> [Text] -> [GitType]
forall a b. (a -> b) -> [a] -> [b]
map Text -> GitType
cvtMode [Text]
mode') [Text]
oid' (Text -> [Char]
T.unpack Text
k),(Text -> GitType
cvtMode Text
mode,Text
oid),Text
fp)
      | Bool
otherwise = [Char] -> ([(GitType, Text, Char)], (GitType, Text), Text)
forall a. HasCallStack => [Char] -> a
error [Char]
"in parseDtLine"
      where
        sanityCheck :: Bool
sanityCheck = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Text -> Int
T.length Text
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n

        n :: Int
n = Text -> Int
T.length Text
cols
        ([Text]
mode',Text
mode:[Text]
tmp') = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') Text
l''
        ([Text]
oid',[Text
oid,Text
k]) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Text]
tmp'
        [Text
l'',Text
fp] = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\t') Text
l'
        (Text
cols,Text
l') = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') Text
l

gitDiffTreePatch :: FilePath -> GitRef -> Text -> Sh Text
gitDiffTreePatch :: [Char] -> Text -> Text -> Sh Text
gitDiffTreePatch [Char]
d Text
ref Text
fname = [Char] -> Text -> [Text] -> Sh Text
runGit [Char]
d Text
"diff-tree" [Text
"--root", Text
"--cc", Text
"-r", Text
ref, Text
"--", Text
fname]

z40 :: GitRef
z40 :: Text
z40 = [Char] -> Text
T.pack (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
40 Char
'0')

data GitType
    = GitTypeVoid
    | GitTypeRegFile
    | GitTypeExeFile
    | GitTypeTree
    | GitTypeSymLink
    | GitTypeGitLink
    deriving stock (Int -> GitType -> ShowS
[GitType] -> ShowS
GitType -> [Char]
(Int -> GitType -> ShowS)
-> (GitType -> [Char]) -> ([GitType] -> ShowS) -> Show GitType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitType -> ShowS
showsPrec :: Int -> GitType -> ShowS
$cshow :: GitType -> [Char]
show :: GitType -> [Char]
$cshowList :: [GitType] -> ShowS
showList :: [GitType] -> ShowS
Show,GitType -> GitType -> Bool
(GitType -> GitType -> Bool)
-> (GitType -> GitType -> Bool) -> Eq GitType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitType -> GitType -> Bool
== :: GitType -> GitType -> Bool
$c/= :: GitType -> GitType -> Bool
/= :: GitType -> GitType -> Bool
Eq,Eq GitType
Eq GitType
-> (GitType -> GitType -> Ordering)
-> (GitType -> GitType -> Bool)
-> (GitType -> GitType -> Bool)
-> (GitType -> GitType -> Bool)
-> (GitType -> GitType -> Bool)
-> (GitType -> GitType -> GitType)
-> (GitType -> GitType -> GitType)
-> Ord GitType
GitType -> GitType -> Bool
GitType -> GitType -> Ordering
GitType -> GitType -> GitType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GitType -> GitType -> Ordering
compare :: GitType -> GitType -> Ordering
$c< :: GitType -> GitType -> Bool
< :: GitType -> GitType -> Bool
$c<= :: GitType -> GitType -> Bool
<= :: GitType -> GitType -> Bool
$c> :: GitType -> GitType -> Bool
> :: GitType -> GitType -> Bool
$c>= :: GitType -> GitType -> Bool
>= :: GitType -> GitType -> Bool
$cmax :: GitType -> GitType -> GitType
max :: GitType -> GitType -> GitType
$cmin :: GitType -> GitType -> GitType
min :: GitType -> GitType -> GitType
Ord,Int -> GitType
GitType -> Int
GitType -> [GitType]
GitType -> GitType
GitType -> GitType -> [GitType]
GitType -> GitType -> GitType -> [GitType]
(GitType -> GitType)
-> (GitType -> GitType)
-> (Int -> GitType)
-> (GitType -> Int)
-> (GitType -> [GitType])
-> (GitType -> GitType -> [GitType])
-> (GitType -> GitType -> [GitType])
-> (GitType -> GitType -> GitType -> [GitType])
-> Enum GitType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GitType -> GitType
succ :: GitType -> GitType
$cpred :: GitType -> GitType
pred :: GitType -> GitType
$ctoEnum :: Int -> GitType
toEnum :: Int -> GitType
$cfromEnum :: GitType -> Int
fromEnum :: GitType -> Int
$cenumFrom :: GitType -> [GitType]
enumFrom :: GitType -> [GitType]
$cenumFromThen :: GitType -> GitType -> [GitType]
enumFromThen :: GitType -> GitType -> [GitType]
$cenumFromTo :: GitType -> GitType -> [GitType]
enumFromTo :: GitType -> GitType -> [GitType]
$cenumFromThenTo :: GitType -> GitType -> GitType -> [GitType]
enumFromThenTo :: GitType -> GitType -> GitType -> [GitType]
Enum)

instance NFData GitType where rnf :: GitType -> ()
rnf !GitType
_ = ()

cvtMode :: Text -> GitType
cvtMode :: Text -> GitType
cvtMode Text
"000000" = GitType
GitTypeVoid
cvtMode Text
"040000" = GitType
GitTypeSymLink
cvtMode Text
"100644" = GitType
GitTypeRegFile
cvtMode Text
"100755" = GitType
GitTypeExeFile
cvtMode Text
"120000" = GitType
GitTypeSymLink
cvtMode Text
"160000" = GitType
GitTypeGitLink
cvtMode Text
x = [Char] -> GitType
forall a. HasCallStack => [Char] -> a
error ([Char]
"cvtMode: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
x)

tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = [Char] -> Text
T.pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show