{-# LANGUAGE DuplicateRecordFields #-}
module Data.Git.Phoenix.CmdArgs where

import Data.Char (toLower)
import Data.Tagged (Tagged (..))
import Data.Time.Clock
import Data.Time.Format
import Options.Applicative
import Relude
import System.FilePath ((</>))
import System.IO.Unsafe
import Text.Regex.TDFA

data InDir
data OutDir
data ShaPrefix
data DaysAfter
data DaysBefore

data SearchCommitBy
  = SearchCommitBy2
    { SearchCommitBy -> FilePath
author :: String
    , SearchCommitBy -> Tagged DaysBefore Int
daysBefore :: Tagged DaysBefore Int
    , SearchCommitBy -> Tagged InDir FilePath
uberRepoDir :: Tagged InDir FilePath
    , SearchCommitBy -> Tagged DaysAfter Int
daysAfter :: Tagged DaysAfter Int
    }
  deriving (Int -> SearchCommitBy -> ShowS
[SearchCommitBy] -> ShowS
SearchCommitBy -> FilePath
(Int -> SearchCommitBy -> ShowS)
-> (SearchCommitBy -> FilePath)
-> ([SearchCommitBy] -> ShowS)
-> Show SearchCommitBy
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchCommitBy -> ShowS
showsPrec :: Int -> SearchCommitBy -> ShowS
$cshow :: SearchCommitBy -> FilePath
show :: SearchCommitBy -> FilePath
$cshowList :: [SearchCommitBy] -> ShowS
showList :: [SearchCommitBy] -> ShowS
Show, SearchCommitBy -> SearchCommitBy -> Bool
(SearchCommitBy -> SearchCommitBy -> Bool)
-> (SearchCommitBy -> SearchCommitBy -> Bool) -> Eq SearchCommitBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchCommitBy -> SearchCommitBy -> Bool
== :: SearchCommitBy -> SearchCommitBy -> Bool
$c/= :: SearchCommitBy -> SearchCommitBy -> Bool
/= :: SearchCommitBy -> SearchCommitBy -> Bool
Eq)

data HeadsDiscovery
  = HeadsDiscovery2
    { HeadsDiscovery -> FilePath
author :: String
    , HeadsDiscovery -> Tagged InDir FilePath
uberRepoDir :: Tagged InDir FilePath
    }
  deriving (Int -> HeadsDiscovery -> ShowS
[HeadsDiscovery] -> ShowS
HeadsDiscovery -> FilePath
(Int -> HeadsDiscovery -> ShowS)
-> (HeadsDiscovery -> FilePath)
-> ([HeadsDiscovery] -> ShowS)
-> Show HeadsDiscovery
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeadsDiscovery -> ShowS
showsPrec :: Int -> HeadsDiscovery -> ShowS
$cshow :: HeadsDiscovery -> FilePath
show :: HeadsDiscovery -> FilePath
$cshowList :: [HeadsDiscovery] -> ShowS
showList :: [HeadsDiscovery] -> ShowS
Show, HeadsDiscovery -> HeadsDiscovery -> Bool
(HeadsDiscovery -> HeadsDiscovery -> Bool)
-> (HeadsDiscovery -> HeadsDiscovery -> Bool) -> Eq HeadsDiscovery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeadsDiscovery -> HeadsDiscovery -> Bool
== :: HeadsDiscovery -> HeadsDiscovery -> Bool
$c/= :: HeadsDiscovery -> HeadsDiscovery -> Bool
/= :: HeadsDiscovery -> HeadsDiscovery -> Bool
Eq)

data CmdArgs
  = BuildUberRepo
    { CmdArgs -> Tagged InDir FilePath
inDir :: Tagged InDir FilePath
    , CmdArgs -> Tagged OutDir FilePath
outDir :: Tagged OutDir FilePath
    }
  | ExtractCommitTreeAsGitRepo
    { CmdArgs -> Tagged ShaPrefix FilePath
rootCommit :: Tagged ShaPrefix String
    , CmdArgs -> Tagged InDir FilePath
uberRepoDir :: Tagged InDir FilePath
    , CmdArgs -> Tagged OutDir FilePath
gitRepoOut :: Tagged OutDir FilePath
    }
  | SearchCommitBy SearchCommitBy
  | HeadsDiscovery HeadsDiscovery
  | GitPhoenixVersion
    deriving (Int -> CmdArgs -> ShowS
[CmdArgs] -> ShowS
CmdArgs -> FilePath
(Int -> CmdArgs -> ShowS)
-> (CmdArgs -> FilePath) -> ([CmdArgs] -> ShowS) -> Show CmdArgs
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmdArgs -> ShowS
showsPrec :: Int -> CmdArgs -> ShowS
$cshow :: CmdArgs -> FilePath
show :: CmdArgs -> FilePath
$cshowList :: [CmdArgs] -> ShowS
showList :: [CmdArgs] -> ShowS
Show, CmdArgs -> CmdArgs -> Bool
(CmdArgs -> CmdArgs -> Bool)
-> (CmdArgs -> CmdArgs -> Bool) -> Eq CmdArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmdArgs -> CmdArgs -> Bool
== :: CmdArgs -> CmdArgs -> Bool
$c/= :: CmdArgs -> CmdArgs -> Bool
/= :: CmdArgs -> CmdArgs -> Bool
Eq)

execWithArgs :: MonadIO m => (CmdArgs -> m a) -> m a
execWithArgs :: forall (m :: * -> *) a. MonadIO m => (CmdArgs -> m a) -> m a
execWithArgs CmdArgs -> m a
a = CmdArgs -> m a
a (CmdArgs -> m a) -> m CmdArgs -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CmdArgs -> m CmdArgs
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ParserInfo CmdArgs -> IO CmdArgs
forall a. ParserInfo a -> IO a
execParser (ParserInfo CmdArgs -> IO CmdArgs)
-> ParserInfo CmdArgs -> IO CmdArgs
forall a b. (a -> b) -> a -> b
$ Parser CmdArgs -> InfoMod CmdArgs -> ParserInfo CmdArgs
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser CmdArgs
cmdp Parser CmdArgs -> Parser (CmdArgs -> CmdArgs) -> Parser CmdArgs
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CmdArgs -> CmdArgs)
forall a. Parser (a -> a)
helper) InfoMod CmdArgs
forall {a}. InfoMod a
phelp)
  where
    authorP :: Parser FilePath
authorP =
      Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"author" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
"." Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
                 FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Regex pattern of commit's author")
    uberP :: Parser CmdArgs
uberP = Tagged InDir FilePath -> Tagged OutDir FilePath -> CmdArgs
BuildUberRepo (Tagged InDir FilePath -> Tagged OutDir FilePath -> CmdArgs)
-> Parser (Tagged InDir FilePath)
-> Parser (Tagged OutDir FilePath -> CmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Tagged InDir FilePath)
inputDirOp Parser (Tagged OutDir FilePath -> CmdArgs)
-> Parser (Tagged OutDir FilePath) -> Parser CmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Tagged OutDir FilePath)
outputDirOp
    extractP :: Parser CmdArgs
extractP = Tagged ShaPrefix FilePath
-> Tagged InDir FilePath -> Tagged OutDir FilePath -> CmdArgs
ExtractCommitTreeAsGitRepo (Tagged ShaPrefix FilePath
 -> Tagged InDir FilePath -> Tagged OutDir FilePath -> CmdArgs)
-> Parser (Tagged ShaPrefix FilePath)
-> Parser
     (Tagged InDir FilePath -> Tagged OutDir FilePath -> CmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Tagged ShaPrefix FilePath)
shaP Parser (Tagged InDir FilePath -> Tagged OutDir FilePath -> CmdArgs)
-> Parser (Tagged InDir FilePath)
-> Parser (Tagged OutDir FilePath -> CmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Tagged InDir FilePath)
inUberDirOp Parser (Tagged OutDir FilePath -> CmdArgs)
-> Parser (Tagged OutDir FilePath) -> Parser CmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Tagged OutDir FilePath)
gitOutDirOp
    headsDiscoveryP :: Parser CmdArgs
headsDiscoveryP = HeadsDiscovery -> CmdArgs
HeadsDiscovery (HeadsDiscovery -> CmdArgs)
-> Parser HeadsDiscovery -> Parser CmdArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Tagged InDir FilePath -> HeadsDiscovery
HeadsDiscovery2 (FilePath -> Tagged InDir FilePath -> HeadsDiscovery)
-> Parser FilePath
-> Parser (Tagged InDir FilePath -> HeadsDiscovery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
authorP Parser (Tagged InDir FilePath -> HeadsDiscovery)
-> Parser (Tagged InDir FilePath) -> Parser HeadsDiscovery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Tagged InDir FilePath)
inUberDirOp)
    searchP :: Parser CmdArgs
searchP =
      SearchCommitBy -> CmdArgs
SearchCommitBy (SearchCommitBy -> CmdArgs)
-> Parser SearchCommitBy -> Parser CmdArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (FilePath
-> Tagged DaysBefore Int
-> Tagged InDir FilePath
-> Tagged DaysAfter Int
-> SearchCommitBy
SearchCommitBy2
          (FilePath
 -> Tagged DaysBefore Int
 -> Tagged InDir FilePath
 -> Tagged DaysAfter Int
 -> SearchCommitBy)
-> Parser FilePath
-> Parser
     (Tagged DaysBefore Int
      -> Tagged InDir FilePath -> Tagged DaysAfter Int -> SearchCommitBy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
authorP
          Parser
  (Tagged DaysBefore Int
   -> Tagged InDir FilePath -> Tagged DaysAfter Int -> SearchCommitBy)
-> Parser (Tagged DaysBefore Int)
-> Parser
     (Tagged InDir FilePath -> Tagged DaysAfter Int -> SearchCommitBy)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Tagged DaysBefore Int
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged DaysBefore Int)
-> Parser Int -> Parser (Tagged DaysBefore Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"days-before" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
0
                           Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Exclude commits older than N days"))
          Parser
  (Tagged InDir FilePath -> Tagged DaysAfter Int -> SearchCommitBy)
-> Parser (Tagged InDir FilePath)
-> Parser (Tagged DaysAfter Int -> SearchCommitBy)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Tagged InDir FilePath)
inUberDirOp
          Parser (Tagged DaysAfter Int -> SearchCommitBy)
-> Parser (Tagged DaysAfter Int) -> Parser SearchCommitBy
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Tagged DaysAfter Int
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged DaysAfter Int)
-> Parser Int -> Parser (Tagged DaysAfter Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"days-after" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
180
                           Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Exclude commits newer than N days")))
    cmdp :: Parser CmdArgs
cmdp =
      Mod CommandFields CmdArgs -> Parser CmdArgs
forall a. Mod CommandFields a -> Parser a
hsubparser
        (  FilePath -> ParserInfo CmdArgs -> Mod CommandFields CmdArgs
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"uber"
           (Parser CmdArgs -> FilePath -> ParserInfo CmdArgs
forall {a}. Parser a -> FilePath -> ParserInfo a
infoP Parser CmdArgs
uberP (FilePath -> ParserInfo CmdArgs) -> FilePath -> ParserInfo CmdArgs
forall a b. (a -> b) -> a -> b
$
             FilePath
"discovers GIT object files in disk recovery tool output and " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
             FilePath
"puts symlinks to them in a folder (uber repo)")
        Mod CommandFields CmdArgs
-> Mod CommandFields CmdArgs -> Mod CommandFields CmdArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo CmdArgs -> Mod CommandFields CmdArgs
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"extract"
           (Parser CmdArgs -> FilePath -> ParserInfo CmdArgs
forall {a}. Parser a -> FilePath -> ParserInfo a
infoP Parser CmdArgs
extractP FilePath
"clone GIT repository with root commit sha")
        Mod CommandFields CmdArgs
-> Mod CommandFields CmdArgs -> Mod CommandFields CmdArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo CmdArgs -> Mod CommandFields CmdArgs
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"heads"
           (Parser CmdArgs -> FilePath -> ParserInfo CmdArgs
forall {a}. Parser a -> FilePath -> ParserInfo a
infoP Parser CmdArgs
headsDiscoveryP FilePath
"discover commits without descendants")
        Mod CommandFields CmdArgs
-> Mod CommandFields CmdArgs -> Mod CommandFields CmdArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo CmdArgs -> Mod CommandFields CmdArgs
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"version"
           (Parser CmdArgs -> FilePath -> ParserInfo CmdArgs
forall {a}. Parser a -> FilePath -> ParserInfo a
infoP (CmdArgs -> Parser CmdArgs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmdArgs
GitPhoenixVersion) FilePath
"print program version")
        Mod CommandFields CmdArgs
-> Mod CommandFields CmdArgs -> Mod CommandFields CmdArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo CmdArgs -> Mod CommandFields CmdArgs
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"search"
           (Parser CmdArgs -> FilePath -> ParserInfo CmdArgs
forall {a}. Parser a -> FilePath -> ParserInfo a
infoP Parser CmdArgs
searchP FilePath
"find commit in the uber repo"))

    infoP :: Parser a -> FilePath -> ParserInfo a
infoP Parser a
p FilePath
h = Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser a
p (FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
progDesc FilePath
h InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> InfoMod a
forall {a}. InfoMod a
fullDesc)
    phelp :: InfoMod a
phelp =
      FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
progDesc
        FilePath
"git-phoenix reconstructs GIT repositories from output of a disk recovery tool"

defaultOutputDir :: IO FilePath
defaultOutputDir :: IO FilePath
defaultOutputDir =
  TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"git-phoenix-objects-%F_%H_%M_%S"
  (UTCTime -> FilePath) -> IO UTCTime -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

outputDirOp :: Parser (Tagged OutDir FilePath)
outputDirOp :: Parser (Tagged OutDir FilePath)
outputDirOp = FilePath -> Tagged OutDir FilePath
forall {k} (s :: k) b. b -> Tagged s b
Tagged (FilePath -> Tagged OutDir FilePath)
-> Parser FilePath -> Parser (Tagged OutDir FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
  ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"output"
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o'
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (FilePath
"." FilePath -> ShowS
</> IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO IO FilePath
defaultOutputDir)
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help ( FilePath
"Path to objects folder of an uber GIT repo containing " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              FilePath
"all discovered GIT objects. Default name is timestamp. " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              FilePath
"Default path is current folder.")
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OUTDIR"
  )

gitOutDirOp :: Parser (Tagged OutDir FilePath)
gitOutDirOp :: Parser (Tagged OutDir FilePath)
gitOutDirOp = FilePath -> Tagged OutDir FilePath
forall {k} (s :: k) b. b -> Tagged s b
Tagged (FilePath -> Tagged OutDir FilePath)
-> Parser FilePath -> Parser (Tagged OutDir FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
  ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"git-repo"
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g'
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to output GIT repository"
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"GIT-DIR"
  )

sha1PrefixRegex :: String
sha1PrefixRegex :: FilePath
sha1PrefixRegex = FilePath
"^[A-Fa-f0-9]+$"

shaP :: Parser (Tagged ShaPrefix String)
shaP :: Parser (Tagged ShaPrefix FilePath)
shaP = FilePath -> Tagged ShaPrefix FilePath
forall {k} (s :: k) b. b -> Tagged s b
Tagged (FilePath -> Tagged ShaPrefix FilePath)
-> Parser FilePath -> Parser (Tagged ShaPrefix FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Maybe FilePath) -> ReadM FilePath
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader (\FilePath
s -> if (FilePath
s FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
sha1PrefixRegex) :: Bool
                             then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower FilePath
s
                             else Maybe FilePath
forall a. Maybe a
Nothing))
  (  FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"sha-prefix"
  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"unique SHA1 prefix of commit tree root in hexdecimal form"
  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SHA1"
  )

inUberDirOp :: Parser (Tagged InDir FilePath)
inUberDirOp :: Parser (Tagged InDir FilePath)
inUberDirOp = FilePath -> Tagged InDir FilePath
forall {k} (s :: k) b. b -> Tagged s b
Tagged (FilePath -> Tagged InDir FilePath)
-> Parser FilePath -> Parser (Tagged InDir FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
  ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"uber-dir"
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to uber dir with discovered GIT objects"
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"UBER-DIR"
  )

inputDirOp :: Parser (Tagged InDir FilePath)
inputDirOp :: Parser (Tagged InDir FilePath)
inputDirOp = FilePath -> Tagged InDir FilePath
forall {k} (s :: k) b. b -> Tagged s b
Tagged (FilePath -> Tagged InDir FilePath)
-> Parser FilePath -> Parser (Tagged InDir FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
  ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"input"
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help ( FilePath
"Path to a folder with files produced by a disk recovery tool. " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              FilePath
"e.g. photorec (testdisk). File names and locations do not matter.")
    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PHOTOREC-OUTPUT-DIR"
  )