--  Copyright (C) 2002-2014 David Roundy, Petr Rockai, Owen Stephens
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

{-# LANGUAGE OverloadedStrings #-}

module Darcs.UI.Commands.Convert.Import ( convertImport ) where

import Darcs.Prelude hiding ( readFile, lex )

import Control.Applicative ((<|>),many)
import Control.Arrow ((&&&), second)
import Control.Monad (unless, void, when)
import Control.Monad.State.Strict (gets, modify)
import Control.Monad.Trans (liftIO)

import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Attoparsec.ByteString.Char8 ((<?>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy.Char8 as BLC
import Data.IORef (modifyIORef, newIORef)
import Data.Maybe (fromMaybe)
import Data.Word (Word8)

import System.Directory (doesFileExist)
import System.FilePath.Posix ((</>))
import System.IO (stdin)

import Darcs.Patch.Depends ( getUncovered )
import Darcs.Patch.PatchInfoAnd ( n2pia )
import Darcs.Patch ( PrimOf, RepoPatch, move )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Named ( Named(..), infopatch )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..)
    , RL(..)
    , (+<+)
    , reverseFL
    , reverseRL
    )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unFreeLeft )

import Darcs.Patch.Info ( PatchInfo, patchinfo )
import Darcs.Patch.Prim ( sortCoalesceFL )
import Darcs.Patch.RepoType ( IsRepoType(..) )

import Darcs.Repository
    ( EmptyRepository(..)
    , Repository
    , cleanRepository
    , createPristineDirectoryTree
    , createRepository
    , finalizeRepositoryChanges
    , readTentativeRepo
    , repoCache
    , repoLocation
    , revertRepositoryChanges
    , withUMaskFlag
    )
import Darcs.Repository.Diff (treeDiff)
import Darcs.Repository.Flags (Compression(..), DiffAlgorithm(PatienceDiff))
import Darcs.Repository.Hashed (addToTentativeInventory)
import Darcs.Repository.Paths (pristineDirPath, tentativePristinePath)
import Darcs.Repository.Prefs (FileType(..))
import Darcs.Repository.State (readRecorded)

import Darcs.UI.Commands
    ( DarcsCommand(..)
    , nodefaults
    , withStdOpts
    )
import Darcs.UI.Commands.Convert.Util
    ( Marks
    , addMark
    , emptyMarks
    , getMark
    , patchHash
    , updatePending
    )
import Darcs.UI.Commands.Util.Tree (treeHasDir, treeHasFile)
import Darcs.UI.Completion (noArgs)
import Darcs.UI.Flags
    ( DarcsFlag
    , patchFormat
    , patchIndexNo
    , umask
    , useCache
    , withWorkingDir
    )
import Darcs.UI.Options
    ( (?)
    , (^)
    , defaultFlags
    , ocheck
    , odesc
    )
import qualified Darcs.UI.Options.All as O

import Darcs.Util.ByteString (decodeLocale, unpackPSFromUTF8)
import Darcs.Util.DateTime
    ( formatDateTime
    , parseDateTime
    , startOfTime
    )
import Darcs.Util.Global (darcsdir)
import Darcs.Util.Hash (Hash(..), encodeBase16, sha256)
import Darcs.Util.Lock (withNewDirectory)
import Darcs.Util.Path
    ( AbsolutePath
    , AnchoredPath(..)
    , appendPath
    , floatPath
    , makeName
    , parent
    , darcsdirName
    )
import Darcs.Util.Printer ( Doc, text )
import qualified Darcs.Util.Tree as T
import Darcs.Util.Tree
    ( Tree
    , TreeItem(..)
    , findTree
    , listImmediate
    , readBlob
    , treeHash
    )
import Darcs.Util.Tree.Hashed (darcsAddMissingHashes, hashedTreeIO)
import qualified Darcs.Util.Tree.Monad as TM
import Darcs.Util.Tree.Monad hiding (createDirectory, exists, rename)


convertImportHelp :: Doc
convertImportHelp :: Doc
convertImportHelp = [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
 [ [Char]
"This command imports git repositories into new darcs repositories."
 , [Char]
"Further options are accepted (see `darcs help init`)."
 , [Char]
""
 , [Char]
"To convert a git repo to a new darcs one you may run:"
 , [Char]
""
 , [Char]
"    $ (cd gitrepo && git fast-export --all -M) | darcs convert import darcsmirror"
 , [Char]
""
 , [Char]
"WARNING: git repositories with branches will produce weird results,"
 , [Char]
"         use at your own risks."
 , [Char]
""
 , [Char]
"Incremental import with marksfiles is currently not supported."
 ]

convertImport :: DarcsCommand
convertImport :: DarcsCommand
convertImport = DarcsCommand
    { commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
    , commandName :: [Char]
commandName = [Char]
"import"
    , commandHelp :: Doc
commandHelp = Doc
convertImportHelp
    , commandDescription :: [Char]
commandDescription = [Char]
"Import from a git-fast-export stream into darcs"
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = [[Char]
"[<DIRECTORY>]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
fastImport
    , commandPrereq :: [DarcsFlag] -> IO (Either [Char] ())
commandPrereq = \[DarcsFlag]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
noArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
nodefaults
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> UMask -> a)
convertImportAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char]
   -> SetScriptsExecutable -> PatchFormat -> WithWorkingDir -> a)
convertImportBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
  a
  (Maybe [Char]
   -> SetScriptsExecutable
   -> PatchFormat
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
convertImportOpts
    , commandCheckOptions :: [DarcsFlag] -> [[Char]]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [[Char]]
ocheck forall {a}.
DarcsOption
  a
  (Maybe [Char]
   -> SetScriptsExecutable
   -> PatchFormat
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
convertImportOpts
    }
  where
    convertImportBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char]
   -> SetScriptsExecutable -> PatchFormat -> WithWorkingDir -> a)
convertImportBasicOpts
      = PrimDarcsOption (Maybe [Char])
O.newRepo
      forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
      forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption PatchFormat
O.patchFormat
      forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithWorkingDir
O.withWorkingDir
    convertImportAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> UMask -> a)
convertImportAdvancedOpts = PrimDarcsOption WithPatchIndex
O.patchIndexNo forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UMask
O.umask
    convertImportOpts :: DarcsOption
  a
  (Maybe [Char]
   -> SetScriptsExecutable
   -> PatchFormat
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
convertImportOpts = forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char]
   -> SetScriptsExecutable -> PatchFormat -> WithWorkingDir -> a)
convertImportBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> UMask -> a)
convertImportAdvancedOpts

type Marked = Maybe Int
type Branch = B.ByteString
type AuthorInfo = B.ByteString
type Message = B.ByteString
type Content = B.ByteString
type Tag = B.ByteString

data RefId = MarkId Int | HashId B.ByteString | Inline
           deriving Int -> RefId -> ShowS
[RefId] -> ShowS
RefId -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RefId] -> ShowS
$cshowList :: [RefId] -> ShowS
show :: RefId -> [Char]
$cshow :: RefId -> [Char]
showsPrec :: Int -> RefId -> ShowS
$cshowsPrec :: Int -> RefId -> ShowS
Show

-- Newish (> 1.7.6.1) Git either quotes filenames or has two
-- non-special-char-containing paths. Older git doesn't do any quoting, so
-- we'll have to manually try and find the correct paths, when we use the
-- paths.
data CopyRenameNames = Quoted B.ByteString B.ByteString
                     | Unquoted B.ByteString deriving Int -> CopyRenameNames -> ShowS
[CopyRenameNames] -> ShowS
CopyRenameNames -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CopyRenameNames] -> ShowS
$cshowList :: [CopyRenameNames] -> ShowS
show :: CopyRenameNames -> [Char]
$cshow :: CopyRenameNames -> [Char]
showsPrec :: Int -> CopyRenameNames -> ShowS
$cshowsPrec :: Int -> CopyRenameNames -> ShowS
Show

data Object = Blob (Maybe Int) Content
            | Reset Branch (Maybe RefId)
            | Commit Branch Marked AuthorInfo Message
            | Tag Tag Int AuthorInfo Message
            | Modify (Either Int Content) B.ByteString -- (mark or content), filename
            | Gitlink B.ByteString
            | Copy CopyRenameNames
            | Rename CopyRenameNames
            | Delete B.ByteString -- filename
            | From Int
            | Merge Int
            | Progress B.ByteString
            | End
            deriving Int -> Object -> ShowS
[Object] -> ShowS
Object -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> [Char]
$cshow :: Object -> [Char]
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Show

type Ancestors = (Marked, [Int])
data State p where
  Toplevel :: Marked -> Branch -> State p
  InCommit :: Marked -> Ancestors -> Branch -> Tree IO -> RL (PrimOf p) cX cY -> PatchInfo -> State p
  Done :: State p

instance Show (State p) where
  show :: State p -> [Char]
show Toplevel {} = [Char]
"Toplevel"
  show InCommit {} = [Char]
"InCommit"
  show State p
Done =  [Char]
"Done"

fastImport :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
fastImport :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
fastImport (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [[Char]
outrepo] =
  forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ [Char] -> IO () -> IO ()
withNewDirectory [Char]
outrepo forall a b. (a -> b) -> a -> b
$ do
    EmptyRepository Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo <- PatchFormat
-> WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO EmptyRepository
createRepository
      (PrimDarcsOption PatchFormat
patchFormat forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      (PrimDarcsOption WithWorkingDir
withWorkingDir forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      (PrimDarcsOption WithPatchIndex
patchIndexNo forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
    -- TODO implement --dry-run, which would be read-only?
    Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts)
    ()
marks <- forall (rt :: RepoType) (p :: * -> * -> *) r u.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p r u r -> Marks -> IO ()
fastImport' Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo Marks
emptyMarks
    Repository ('RepoType 'NoRebase) p Origin Origin Origin
_ <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts) Compression
GzipCompression
    forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO ()
cleanRepository Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo
    forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char] -> WithWorkingDir -> IO ()
createPristineDirectoryTree Repository ('RepoType 'NoRebase) p Origin Origin Origin
_repo [Char]
"." (PrimDarcsOption WithWorkingDir
withWorkingDir forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
marks
fastImport (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [[Char]]
_ = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"I need exactly one output repository."

fastImport' :: forall rt p r u . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
               Repository rt p r u r -> Marks -> IO ()
fastImport' :: forall (rt :: RepoType) (p :: * -> * -> *) r u.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p r u r -> Marks -> IO ()
fastImport' Repository rt p r u r
repo Marks
marks = do
    Tree IO
pristine <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p r u r
repo
    IORef Marks
marksref <- forall a. a -> IO (IORef a)
newIORef Marks
marks
    let initial :: State p
initial = forall (p :: * -> * -> *). Maybe Int -> ByteString -> State p
Toplevel forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BC.pack [Char]
"refs/branches/master"

        go :: State p -> B.ByteString -> TreeIO ()
        go :: State p -> ByteString -> TreeIO ()
go State p
state ByteString
rest = do (ByteString
rest', Object
item) <- ByteString -> TreeIO (ByteString, Object)
parseObject ByteString
rest
                           State p
state' <- State p -> Object -> TreeIO (State p)
process State p
state Object
item
                           case State p
state' of
                             State p
Done -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                             State p
_ -> State p -> ByteString -> TreeIO ()
go State p
state' ByteString
rest'

        -- sort marks into buckets, since there can be a *lot* of them
        markpath :: Int -> AnchoredPath
        markpath :: Int -> AnchoredPath
markpath Int
n = [Char] -> AnchoredPath
floatPath ([Char]
darcsdir [Char] -> ShowS
</> [Char]
"marks")
                        AnchoredPath -> Name -> AnchoredPath
`appendPath` (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] Name
makeName forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show (Int
n forall a. Integral a => a -> a -> a
`div` Int
1000))
                        AnchoredPath -> Name -> AnchoredPath
`appendPath` (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] Name
makeName forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show (Int
n forall a. Integral a => a -> a -> a
`mod` Int
1000))

        makeinfo :: ByteString -> ByteString -> Bool -> m PatchInfo
makeinfo ByteString
author ByteString
message Bool
tag = do
          let ([Char]
name, [[Char]]
log) = case ByteString -> [Char]
unpackPSFromUTF8 ByteString
message of
                                      [Char]
"" -> ([Char]
"Unnamed patch", [])
                                      [Char]
msg -> (forall a. [a] -> a
head forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. [a] -> [a]
tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ [Char]
msg
              ([Char]
author'', [Char]
date'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/=Char
'>') forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpackPSFromUTF8 ByteString
author
              date' :: [Char]
date' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Char]
"0123456789" :: String)) [Char]
date''
              author' :: [Char]
author' = [Char]
author'' forall a. [a] -> [a] -> [a]
++ [Char]
">"
              date :: [Char]
date = [Char] -> UTCTime -> [Char]
formatDateTime [Char]
"%Y%m%d%H%M%S" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe UTCTime
startOfTime ([Char] -> [Char] -> Maybe UTCTime
parseDateTime [Char]
"%s %z" [Char]
date')
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> [[Char]] -> IO PatchInfo
patchinfo [Char]
date (if Bool
tag then [Char]
"TAG " forall a. [a] -> [a] -> [a]
++ [Char]
name else [Char]
name) [Char]
author' [[Char]]
log

        addtag :: ByteString -> ByteString -> m ()
addtag ByteString
author ByteString
msg =
          do PatchInfo
info_ <- forall {m :: * -> *}.
MonadIO m =>
ByteString -> ByteString -> Bool -> m PatchInfo
makeinfo ByteString
author ByteString
msg Bool
True
             Bool
gotany <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
tentativePristinePath
             [PatchInfo]
deps <- if Bool
gotany then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                                      forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> [PatchInfo]
getUncovered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                                        forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, PatchListFormat p, ReadPatch p) =>
Repository rt p wR wU wT -> [Char] -> IO (PatchSet rt p Origin wT)
readTentativeRepo Repository rt p r u r
repo (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p r u r
repo)
                               else forall (m :: * -> *) a. Monad m => a -> m a
return []
             let patch :: Named p wA wA
                 patch :: forall wA. Named p wA wA
patch = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
info_ [PatchInfo]
deps forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
             forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p r u r
repo) Compression
GzipCompression (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia forall wA. Named p wA wA
patch)

        -- processing items
        updateHashes :: RWST (TreeEnv IO) () (TreeState IO) IO (Tree IO)
updateHashes = do
          let nodarcs :: AnchoredPath -> p -> Bool
nodarcs = \(AnchoredPath (Name
x:[Name]
_)) p
_ -> Name
x forall a. Eq a => a -> a -> Bool
/= Name
darcsdirName
              hashblobs :: TreeItem m -> m (TreeItem m)
hashblobs (File blob :: Blob m
blob@(T.Blob m ByteString
con Hash
NoHash)) =
                do Hash
hash <- ByteString -> Hash
sha256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
blob
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Blob m -> TreeItem m
File (forall (m :: * -> *). m ByteString -> Hash -> Blob m
T.Blob m ByteString
con Hash
hash)
              hashblobs TreeItem m
x = forall (m :: * -> *) a. Monad m => a -> m a
return TreeItem m
x
          Tree IO
tree' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Monad m =>
(TreeItem m -> m (TreeItem m))
-> (AnchoredPath -> TreeItem m -> Bool) -> Tree m -> m (Tree m)
T.partiallyUpdateTree forall {m :: * -> *}. Monad m => TreeItem m -> m (TreeItem m)
hashblobs forall {p}. AnchoredPath -> p -> Bool
nodarcs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState IO
s -> TreeState IO
s { tree :: Tree IO
tree = Tree IO
tree' }
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: (* -> *) -> *) (m :: * -> *).
FilterTree a m =>
(AnchoredPath -> TreeItem m -> Bool) -> a m -> a m
T.filter forall {p}. AnchoredPath -> p -> Bool
nodarcs Tree IO
tree'

        -- Since git doesn't track directores it implicitly deletes
        -- them when they become empty. We should therefore remove any
        -- directories that become empty (except the repo-root
        -- directory!)
        deleteEmptyParents :: AnchoredPath -> RWST (TreeEnv m) () (TreeState m) m ()
deleteEmptyParents AnchoredPath
fp =
          case AnchoredPath -> Maybe AnchoredPath
parent AnchoredPath
fp of
            Maybe AnchoredPath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just AnchoredPath
directParent -> do
              Maybe (Tree m)
parentTree <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Tree m)
findTree AnchoredPath
directParent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
              case (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Tree m -> [(Name, TreeItem m)]
listImmediate) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Tree m)
parentTree of
                      Just Bool
True -> do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.unlink AnchoredPath
directParent
                                      AnchoredPath -> RWST (TreeEnv m) () (TreeState m) m ()
deleteEmptyParents AnchoredPath
directParent
                      -- Either missing (not possible) or non-empty.
                      Maybe Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

        -- generate a Hunk primitive patch from diffing
        diffCurrent :: State p -> TreeIO (State p)
        diffCurrent :: State p -> TreeIO (State p)
diffCurrent (InCommit Maybe Int
mark Ancestors
ancestors ByteString
branch Tree IO
start RL (PrimOf p) cX cY
ps PatchInfo
info_) = do
          Tree IO
current <- RWST (TreeEnv IO) () (TreeState IO) IO (Tree IO)
updateHashes
          Sealed FL (PrimOf p) cY wX
diff <- forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
             forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> ([Char] -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff DiffAlgorithm
PatienceDiff (forall a b. a -> b -> a
const FileType
TextFile) Tree IO
start Tree IO
current)
          let newps :: RL (PrimOf p) cX wX
newps = RL (PrimOf p) cX cY
ps forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PrimOf p) cY wX
diff
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wY cY.
Maybe Int
-> Ancestors
-> ByteString
-> Tree IO
-> RL (PrimOf p) wY cY
-> PatchInfo
-> State p
InCommit Maybe Int
mark Ancestors
ancestors ByteString
branch Tree IO
current RL (PrimOf p) cX wX
newps PatchInfo
info_
        diffCurrent State p
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"This is never valid outside of a commit."

        process :: State p -> Object -> TreeIO (State p)
        process :: State p -> Object -> TreeIO (State p)
process State p
s (Progress ByteString
p) = do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char]
"progress " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
decodeLocale ByteString
p)
          forall (m :: * -> *) a. Monad m => a -> m a
return State p
s

        process (Toplevel Maybe Int
_ ByteString
_) Object
End = do
          Tree IO
tree' <- (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
darcsAddMissingHashes) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RWST (TreeEnv IO) () (TreeState IO) IO (Tree IO)
updateHashes
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState IO
s -> TreeState IO
s { tree :: Tree IO
tree = Tree IO
tree' } -- lets dump the right tree, without _darcs
          let root :: ByteString
root = Hash -> ByteString
encodeBase16 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Tree m -> Hash
treeHash Tree IO
tree'
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            [Char] -> IO ()
putStrLn [Char]
"\\o/ It seems we survived. Enjoy your new repo."
            [Char] -> ByteString -> IO ()
B.writeFile [Char]
tentativePristinePath forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat [[Char] -> ByteString
BC.pack [Char]
"pristine:", ByteString
root]
          forall (m :: * -> *) a. Monad m => a -> m a
return forall (p :: * -> * -> *). State p
Done

        process (Toplevel Maybe Int
n ByteString
b) (Tag ByteString
tag Int
what ByteString
author ByteString
msg) = do
          if forall a. a -> Maybe a
Just Int
what forall a. Eq a => a -> a -> Bool
== Maybe Int
n
             then forall {m :: * -> *}. MonadIO m => ByteString -> ByteString -> m ()
addtag ByteString
author ByteString
msg
             else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
                    [Char]
"WARNING: Ignoring out-of-order tag " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
decodeLocale ByteString
tag
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *). Maybe Int -> ByteString -> State p
Toplevel Maybe Int
n ByteString
b)

        process (Toplevel Maybe Int
n ByteString
_) (Reset ByteString
branch Maybe RefId
from) =
          do case Maybe RefId
from of
               (Just (MarkId Int
k)) | forall a. a -> Maybe a
Just Int
k forall a. Eq a => a -> a -> Bool
== Maybe Int
n ->
                 forall {m :: * -> *}. MonadIO m => ByteString -> ByteString -> m ()
addtag ([Char] -> ByteString
BC.pack [Char]
"Anonymous Tagger <> 0 +0000") ByteString
branch
               Maybe RefId
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"WARNING: Ignoring out-of-order tag " forall a. [a] -> [a] -> [a]
++
                                        ByteString -> [Char]
decodeLocale ByteString
branch
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *). Maybe Int -> ByteString -> State p
Toplevel Maybe Int
n ByteString
branch

        process (Toplevel Maybe Int
n ByteString
b) (Blob (Just Int
m) ByteString
bits) = do
          forall (m :: * -> *).
Monad m =>
AnchoredPath -> ByteString -> TreeMonad m ()
TM.writeFile (Int -> AnchoredPath
markpath Int
m) ([ByteString] -> ByteString
BLC.fromChunks [ByteString
bits])
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *). Maybe Int -> ByteString -> State p
Toplevel Maybe Int
n ByteString
b

        process State p
x (Gitlink ByteString
link) = do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"WARNING: Ignoring gitlink " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
decodeLocale ByteString
link
          forall (m :: * -> *) a. Monad m => a -> m a
return State p
x

        process (Toplevel Maybe Int
previous ByteString
pbranch) (Commit ByteString
branch Maybe Int
mark ByteString
author ByteString
message) = do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
pbranch forall a. Eq a => a -> a -> Bool
/= ByteString
branch) forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char]
"Tagging branch: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
decodeLocale ByteString
pbranch)
            forall {m :: * -> *}. MonadIO m => ByteString -> ByteString -> m ()
addtag ByteString
author ByteString
pbranch
          PatchInfo
info_ <- forall {m :: * -> *}.
MonadIO m =>
ByteString -> ByteString -> Bool -> m PatchInfo
makeinfo ByteString
author ByteString
message Bool
False
          Tree IO
startstate <- RWST (TreeEnv IO) () (TreeState IO) IO (Tree IO)
updateHashes
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wY cY.
Maybe Int
-> Ancestors
-> ByteString
-> Tree IO
-> RL (PrimOf p) wY cY
-> PatchInfo
-> State p
InCommit Maybe Int
mark (Maybe Int
previous, []) ByteString
branch Tree IO
startstate forall (a :: * -> * -> *) wX. RL a wX wX
NilRL PatchInfo
info_

        process s :: State p
s@InCommit {} (Modify (Left Int
m) ByteString
path) = do
          forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
TM.copy (Int -> AnchoredPath
markpath Int
m) (ByteString -> AnchoredPath
decodePath ByteString
path)
          State p -> TreeIO (State p)
diffCurrent State p
s

        process s :: State p
s@InCommit {} (Modify (Right ByteString
bits) ByteString
path) = do
          forall (m :: * -> *).
Monad m =>
AnchoredPath -> ByteString -> TreeMonad m ()
TM.writeFile (ByteString -> AnchoredPath
decodePath ByteString
path) ([ByteString] -> ByteString
BLC.fromChunks [ByteString
bits])
          State p -> TreeIO (State p)
diffCurrent State p
s

        process s :: State p
s@InCommit {} (Delete ByteString
path) = do
          let floatedPath :: AnchoredPath
floatedPath = ByteString -> AnchoredPath
decodePath ByteString
path
          forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.unlink AnchoredPath
floatedPath
          forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
deleteEmptyParents AnchoredPath
floatedPath
          State p -> TreeIO (State p)
diffCurrent State p
s

        process (InCommit Maybe Int
mark (Maybe Int
prev, [Int]
current) ByteString
branch Tree IO
start RL (PrimOf p) cX cY
ps PatchInfo
info_) (From Int
from) =
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wY cY.
Maybe Int
-> Ancestors
-> ByteString
-> Tree IO
-> RL (PrimOf p) wY cY
-> PatchInfo
-> State p
InCommit Maybe Int
mark (Maybe Int
prev, Int
fromforall a. a -> [a] -> [a]
:[Int]
current) ByteString
branch Tree IO
start RL (PrimOf p) cX cY
ps PatchInfo
info_

        process (InCommit Maybe Int
mark (Maybe Int
prev, [Int]
current) ByteString
branch Tree IO
start RL (PrimOf p) cX cY
ps PatchInfo
info_) (Merge Int
from) =
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wY cY.
Maybe Int
-> Ancestors
-> ByteString
-> Tree IO
-> RL (PrimOf p) wY cY
-> PatchInfo
-> State p
InCommit Maybe Int
mark (Maybe Int
prev, Int
fromforall a. a -> [a] -> [a]
:[Int]
current) ByteString
branch Tree IO
start RL (PrimOf p) cX cY
ps PatchInfo
info_

        process s :: State p
s@InCommit {} (Copy CopyRenameNames
names) = do
            (ByteString
from, ByteString
to) <- CopyRenameNames -> TreeIO (ByteString, ByteString)
extractNames CopyRenameNames
names
            forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
TM.copy (ByteString -> AnchoredPath
decodePath ByteString
from) (ByteString -> AnchoredPath
decodePath ByteString
to)
            -- We can't tell Darcs that a file has been copied, so it'll
            -- show as an addfile.
            State p -> TreeIO (State p)
diffCurrent State p
s

        process s :: State p
s@(InCommit Maybe Int
mark Ancestors
ancestors ByteString
branch Tree IO
start RL (PrimOf p) cX cY
_ PatchInfo
info_) (Rename CopyRenameNames
names) = do
          (ByteString
from, ByteString
to) <- CopyRenameNames -> TreeIO (ByteString, ByteString)
extractNames CopyRenameNames
names
          let uFrom :: AnchoredPath
uFrom = ByteString -> AnchoredPath
decodePath ByteString
from
              uTo :: AnchoredPath
uTo = ByteString -> AnchoredPath
decodePath ByteString
to
          case AnchoredPath -> Maybe AnchoredPath
parent AnchoredPath
uTo of
            Maybe AnchoredPath
Nothing ->
              -- no parents i.e. target is root => nothing to do
              forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just AnchoredPath
parentDir -> do
              Bool
targetDirExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Tree m -> AnchoredPath -> m Bool
treeHasDir Tree IO
start AnchoredPath
uTo
              Bool
targetFileExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Tree m -> AnchoredPath -> m Bool
treeHasFile Tree IO
start AnchoredPath
uTo
              Bool
parentDirExists <-
                  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Tree m -> AnchoredPath -> m Bool
treeHasDir Tree IO
start AnchoredPath
parentDir
              -- If the target exists, remove it; if it doesn't, add all
              -- its parent directories.
              if Bool
targetDirExists Bool -> Bool -> Bool
|| Bool
targetFileExists
                  then forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.unlink AnchoredPath
uTo
                  else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
parentDirExists forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.createDirectory AnchoredPath
parentDir
          (InCommit Maybe Int
_ Ancestors
_ ByteString
_ Tree IO
_ RL (PrimOf p) cX cY
newPs PatchInfo
_) <- State p -> TreeIO (State p)
diffCurrent State p
s
          forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
TM.rename AnchoredPath
uFrom AnchoredPath
uTo
          let ps' :: RL (PrimOf p) cX wZ
ps' = RL (PrimOf p) cX cY
newPs forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> AnchoredPath -> prim wX wY
move AnchoredPath
uFrom AnchoredPath
uTo
          Tree IO
current <- RWST (TreeEnv IO) () (TreeState IO) IO (Tree IO)
updateHashes
          -- ensure empty dirs get deleted
          forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
deleteEmptyParents AnchoredPath
uFrom
          -- run diffCurrent to add the dir deletions prims
          State p -> TreeIO (State p)
diffCurrent (forall (p :: * -> * -> *) wY cY.
Maybe Int
-> Ancestors
-> ByteString
-> Tree IO
-> RL (PrimOf p) wY cY
-> PatchInfo
-> State p
InCommit Maybe Int
mark Ancestors
ancestors ByteString
branch Tree IO
current forall {wZ}. RL (PrimOf p) cX wZ
ps' PatchInfo
info_)

        -- When we leave the commit, create a patch for the cumulated
        -- prims.
        process (InCommit Maybe Int
mark Ancestors
ancestors ByteString
branch Tree IO
_ RL (PrimOf p) cX cY
ps PatchInfo
info_) Object
x = do
          case Ancestors
ancestors of
            (Maybe Int
_, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- OK, previous commit is the ancestor
            (Just Int
n, [Int]
list)
              | Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
list -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- OK, we base off one of the ancestors
              | Bool
otherwise -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
                               [Char]
"WARNING: Linearising non-linear ancestry:" forall a. [a] -> [a] -> [a]
++
                               [Char]
" currently at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
", ancestors " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Int]
list
            (Maybe Int
Nothing, [Int]
list) ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"WARNING: Linearising non-linear ancestry " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Int]
list

          {- current <- updateHashes -} -- why not?
          (FL (PrimOf p) cX cY
prims :: FL (PrimOf p) cX cY)  <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
sortCoalesceFL forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimOf p) cX cY
ps
          let patch :: Named p cX cY
              patch :: Named p cX cY
patch = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
info_ FL (PrimOf p) cX cY
prims
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Cache -> Compression -> PatchInfoAnd rt p wX wY -> IO ()
addToTentativeInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p r u r
repo)
                                                  Compression
GzipCompression (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia Named p cX cY
patch)
          case Maybe Int
mark of
            Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Int
n -> case Marks -> Int -> Maybe ByteString
getMark Marks
marks Int
n of
              Maybe ByteString
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Marks
marksref forall a b. (a -> b) -> a -> b
$ \Marks
m -> Marks -> Int -> ByteString -> Marks
addMark Marks
m Int
n (forall (rt :: RepoType) (p :: * -> * -> *) cX cY.
PatchInfoAnd rt p cX cY -> ByteString
patchHash forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia Named p cX cY
patch)
              Just ByteString
n' -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"FATAL: Mark already exists: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
decodeLocale ByteString
n'
          State p -> Object -> TreeIO (State p)
process (forall (p :: * -> * -> *). Maybe Int -> ByteString -> State p
Toplevel Maybe Int
mark ByteString
branch) Object
x

        process State p
state Object
obj = do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print Object
obj
          forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected object in state " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show State p
state

        extractNames :: CopyRenameNames
                     -> TreeIO (BC.ByteString, BC.ByteString)
        extractNames :: CopyRenameNames -> TreeIO (ByteString, ByteString)
extractNames CopyRenameNames
names = case CopyRenameNames
names of
            Quoted ByteString
f ByteString
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
f, ByteString
t)
            Unquoted ByteString
uqNames -> do
                let spaceIndices :: [Int]
spaceIndices = Char -> ByteString -> [Int]
BC.elemIndices Char
' ' ByteString
uqNames
                    splitStr :: Int -> (ByteString, ByteString)
splitStr = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int -> ByteString -> ByteString
BC.drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> ByteString -> (ByteString, ByteString)
BC.splitAt ByteString
uqNames
                    -- Reverse the components, so we find the longest
                    -- prefix existing name.
                    spaceComponents :: [(ByteString, ByteString)]
spaceComponents = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> (ByteString, ByteString)
splitStr [Int]
spaceIndices
                    componentCount :: Int
componentCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ByteString, ByteString)]
spaceComponents
                if Int
componentCount forall a. Eq a => a -> a -> Bool
== Int
1
                    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(ByteString, ByteString)]
spaceComponents
                    else do
                        let dieMessage :: [Char]
dieMessage = [[Char]] -> [Char]
unwords
                                [ [Char]
"Couldn't determine move/rename"
                                , [Char]
"source/destination filenames, with the"
                                , [Char]
"data produced by this (old) version of"
                                , [Char]
"git, since it uses unquoted, but"
                                , [Char]
"special-character-containing paths."
                                ]
                            lPathExists :: (ByteString, b) -> TreeMonad m Bool
lPathExists (ByteString
l,b
_) =
                                forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
TM.fileExists forall a b. (a -> b) -> a -> b
$ ByteString -> AnchoredPath
decodePath ByteString
l
                            finder :: [(ByteString, b)]
-> RWST (TreeEnv m) () (TreeState m) m (ByteString, b)
finder [] = forall a. HasCallStack => [Char] -> a
error [Char]
dieMessage
                            finder ((ByteString, b)
x : [(ByteString, b)]
rest) = do
                                Bool
xExists <- forall {m :: * -> *} {b}.
Monad m =>
(ByteString, b) -> TreeMonad m Bool
lPathExists (ByteString, b)
x
                                if Bool
xExists then forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString, b)
x else [(ByteString, b)]
-> RWST (TreeEnv m) () (TreeState m) m (ByteString, b)
finder [(ByteString, b)]
rest
                        forall {m :: * -> *} {b}.
Monad m =>
[(ByteString, b)]
-> RWST (TreeEnv m) () (TreeState m) m (ByteString, b)
finder [(ByteString, ByteString)]
spaceComponents

    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. TreeIO a -> Tree IO -> [Char] -> IO (a, Tree IO)
hashedTreeIO (State p -> ByteString -> TreeIO ()
go forall (p :: * -> * -> *). State p
initial ByteString
B.empty) Tree IO
pristine [Char]
pristineDirPath

parseObject :: BC.ByteString -> TreeIO ( BC.ByteString, Object )
parseObject :: ByteString -> TreeIO (ByteString, Object)
parseObject = (ByteString -> Result (Maybe Object))
-> ByteString -> TreeIO (ByteString, Object)
next' ByteString -> Result (Maybe Object)
mbObject
  where mbObject :: ByteString -> Result (Maybe Object)
mbObject = forall a. Parser a -> ByteString -> Result a
A.parse Parser ByteString (Maybe Object)
p_maybeObject

        p_maybeObject :: Parser ByteString (Maybe Object)
p_maybeObject = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString Object
p_object
                        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall t. Chunk t => Parser t ()
A.endOfInput forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)

        lex :: Parser ByteString b -> Parser ByteString b
lex Parser ByteString b
p = Parser ByteString b
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
x -> Parser ()
A.skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b
x
        lexString :: [Char] -> Parser ()
lexString [Char]
s = ByteString -> Parser ByteString
A.string ([Char] -> ByteString
BC.pack [Char]
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
A.skipSpace
        line :: Parser ByteString
line = forall {b}. Parser ByteString b -> Parser ByteString b
lex forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString
A.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\n')

        optional :: f a -> f (Maybe a)
optional f a
p = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` f a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

        p_object :: Parser ByteString Object
p_object = Parser ByteString Object
p_blob
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_reset
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_commit
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_tag
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_modify
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_rename
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_copy
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_from
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_merge
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Object
p_delete
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser ()
lexString [Char]
"progress" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Object
Progress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString
line)

        p_author :: [Char] -> Parser ByteString
p_author [Char]
name = [Char] -> Parser ()
lexString [Char]
name forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
line

        p_reset :: Parser ByteString Object
p_reset = do [Char] -> Parser ()
lexString [Char]
"reset"
                     ByteString
branch <- Parser ByteString
line
                     Maybe RefId
refid <- forall {f :: * -> *} {a}.
(Alternative f, Monad f) =>
f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ [Char] -> Parser ()
lexString [Char]
"from" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString RefId
p_refid
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe RefId -> Object
Reset ByteString
branch Maybe RefId
refid

        p_commit :: Parser ByteString Object
p_commit = do [Char] -> Parser ()
lexString [Char]
"commit"
                      ByteString
branch <- Parser ByteString
line
                      Maybe Int
mark <- forall {f :: * -> *} {a}.
(Alternative f, Monad f) =>
f a -> f (Maybe a)
optional Parser ByteString Int
p_mark
                      Maybe ByteString
_ <- forall {f :: * -> *} {a}.
(Alternative f, Monad f) =>
f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ [Char] -> Parser ByteString
p_author [Char]
"author"
                      ByteString
committer <- [Char] -> Parser ByteString
p_author [Char]
"committer"
                      ByteString
message <- Parser ByteString
p_data
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Int -> ByteString -> ByteString -> Object
Commit ByteString
branch Maybe Int
mark ByteString
committer ByteString
message

        p_tag :: Parser ByteString Object
p_tag = do ()
_ <- [Char] -> Parser ()
lexString [Char]
"tag"
                   ByteString
tag <- Parser ByteString
line
                   [Char] -> Parser ()
lexString [Char]
"from"
                   Int
mark <- Parser ByteString Int
p_marked
                   ByteString
author <- [Char] -> Parser ByteString
p_author [Char]
"tagger"
                   ByteString
message <- Parser ByteString
p_data
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> ByteString -> ByteString -> Object
Tag ByteString
tag Int
mark ByteString
author ByteString
message

        p_blob :: Parser ByteString Object
p_blob = do [Char] -> Parser ()
lexString [Char]
"blob"
                    Maybe Int
mark <- forall {f :: * -> *} {a}.
(Alternative f, Monad f) =>
f a -> f (Maybe a)
optional Parser ByteString Int
p_mark
                    Maybe Int -> ByteString -> Object
Blob Maybe Int
mark forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString
p_data
                  forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"p_blob"

        p_mark :: Parser ByteString Int
p_mark = do [Char] -> Parser ()
lexString [Char]
"mark"
                    Parser ByteString Int
p_marked
                  forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"p_mark"

        p_refid :: Parser ByteString RefId
p_refid = Int -> RefId
MarkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString Int
p_marked
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser ()
lexString [Char]
"inline" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return RefId
Inline)
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> RefId
HashId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString
p_hash

        p_data :: Parser ByteString
p_data = do [Char] -> Parser ()
lexString [Char]
"data"
                    Int
len <- forall a. Integral a => Parser a
A.decimal
                    Char
_ <- Char -> Parser Char
A.char Char
'\n'
                    forall {b}. Parser ByteString b -> Parser ByteString b
lex forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString
A.take Int
len
                  forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"p_data"

        p_marked :: Parser ByteString Int
p_marked = forall {b}. Parser ByteString b -> Parser ByteString b
lex forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
A.char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Integral a => Parser a
A.decimal
        p_hash :: Parser ByteString
p_hash = forall {b}. Parser ByteString b -> Parser ByteString b
lex forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString
A.takeWhile1 ([Char] -> Char -> Bool
A.inClass [Char]
"0123456789abcdefABCDEF")
        p_from :: Parser ByteString Object
p_from = [Char] -> Parser ()
lexString [Char]
"from" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Object
From forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString Int
p_marked
        p_merge :: Parser ByteString Object
p_merge = [Char] -> Parser ()
lexString [Char]
"merge" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Object
Merge forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString Int
p_marked
        p_delete :: Parser ByteString Object
p_delete = [Char] -> Parser ()
lexString [Char]
"D" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Object
Delete forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString
p_maybeQuotedName
        p_rename :: Parser ByteString Object
p_rename = do [Char] -> Parser ()
lexString [Char]
"R"
                      CopyRenameNames
names <- Parser ByteString CopyRenameNames
p_maybeQuotedCopyRenameNames
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CopyRenameNames -> Object
Rename CopyRenameNames
names
        p_copy :: Parser ByteString Object
p_copy = do [Char] -> Parser ()
lexString [Char]
"C"
                    CopyRenameNames
names <- Parser ByteString CopyRenameNames
p_maybeQuotedCopyRenameNames
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CopyRenameNames -> Object
Copy CopyRenameNames
names
        p_modify :: Parser ByteString Object
p_modify = do [Char] -> Parser ()
lexString [Char]
"M"
                      ByteString
mode <- forall {b}. Parser ByteString b -> Parser ByteString b
lex forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Char -> Bool
A.inClass [Char]
"01234567890")
                      RefId
mark <- Parser ByteString RefId
p_refid
                      ByteString
path <- Parser ByteString
p_maybeQuotedName
                      case RefId
mark of
                        HashId ByteString
hash | ByteString
mode forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BC.pack [Char]
"160000" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Object
Gitlink ByteString
hash
                                    | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
":(("
                        MarkId Int
n -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either Int ByteString -> ByteString -> Object
Modify (forall a b. a -> Either a b
Left Int
n) ByteString
path
                        RefId
Inline -> do ByteString
bits <- Parser ByteString
p_data
                                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either Int ByteString -> ByteString -> Object
Modify (forall a b. b -> Either a b
Right ByteString
bits) ByteString
path
        p_maybeQuotedCopyRenameNames :: Parser ByteString CopyRenameNames
p_maybeQuotedCopyRenameNames =
            Parser ByteString CopyRenameNames
p_lexTwoQuotedNames forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> CopyRenameNames
Unquoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser ByteString
line
        p_lexTwoQuotedNames :: Parser ByteString CopyRenameNames
p_lexTwoQuotedNames = do
            ByteString
n1 <- forall {b}. Parser ByteString b -> Parser ByteString b
lex Parser ByteString
p_quotedName
            ByteString
n2 <- forall {b}. Parser ByteString b -> Parser ByteString b
lex Parser ByteString
p_quotedName
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> CopyRenameNames
Quoted ByteString
n1 ByteString
n2
        p_maybeQuotedName :: Parser ByteString
p_maybeQuotedName = forall {b}. Parser ByteString b -> Parser ByteString b
lex (Parser ByteString
p_quotedName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
line)
        p_quotedName :: Parser ByteString
p_quotedName = do
          Char
_ <- Char -> Parser Char
A.char Char
'"'
          [ByteString]
bytes <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString
p_escaped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
p_unescaped)
          Char
_ <- Char -> Parser Char
A.char Char
'"'
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString]
bytes
        p_unescaped :: Parser ByteString
p_unescaped = (Char -> Bool) -> Parser ByteString
A.takeWhile1 (\Char
c->Char
cforall a. Eq a => a -> a -> Bool
/=Char
'"' Bool -> Bool -> Bool
&& Char
cforall a. Eq a => a -> a -> Bool
/=Char
'\\')
        p_escaped :: Parser ByteString
p_escaped = do
          Char
_ <- Char -> Parser Char
A.char Char
'\\'
          Parser ByteString
p_escaped_octal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
p_escaped_char
        p_escaped_octal :: Parser ByteString
p_escaped_octal = do
          let octals :: [Char]
              octals :: [Char]
octals = [Char]
"01234567"
          ByteString
s <- (Char -> Bool) -> Parser ByteString
A.takeWhile1 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
octals)
          let x :: Word8
              x :: Word8
x = forall a. Read a => [Char] -> a
read ([Char]
"0o" forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack ByteString
s)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
B.singleton forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
        p_escaped_char :: Parser ByteString
p_escaped_char =
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> ByteString
BC.singleton forall a b. (a -> b) -> a -> b
$
          Char
'\r' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
A.char Char
'r' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\n' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
A.char Char
'n' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
A.char Char
'"' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
A.char Char
'\\'

        next' :: (B.ByteString -> A.Result (Maybe Object)) -> B.ByteString -> TreeIO (B.ByteString, Object)
        next' :: (ByteString -> Result (Maybe Object))
-> ByteString -> TreeIO (ByteString, Object)
next' ByteString -> Result (Maybe Object)
parser ByteString
rest =
          do ByteString
chunk <- if ByteString -> Bool
B.null ByteString
rest then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
B.hGet Handle
stdin (Int
64 forall a. Num a => a -> a -> a
* Int
1024)
                                     else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
rest
             (ByteString -> Result (Maybe Object))
-> ByteString -> TreeIO (ByteString, Object)
next_chunk ByteString -> Result (Maybe Object)
parser ByteString
chunk

        next_chunk :: (B.ByteString -> A.Result (Maybe Object)) -> B.ByteString -> TreeIO (B.ByteString, Object)
        next_chunk :: (ByteString -> Result (Maybe Object))
-> ByteString -> TreeIO (ByteString, Object)
next_chunk ByteString -> Result (Maybe Object)
parser ByteString
chunk =
          case ByteString -> Result (Maybe Object)
parser ByteString
chunk of
             A.Done ByteString
rest Maybe Object
result -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
rest, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object
End forall a. a -> a
id Maybe Object
result) -- not sure about the maybe
             A.Partial ByteString -> Result (Maybe Object)
cont -> (ByteString -> Result (Maybe Object))
-> ByteString -> TreeIO (ByteString, Object)
next' ByteString -> Result (Maybe Object)
cont ByteString
B.empty
             A.Fail ByteString
_ [[Char]]
ctx [Char]
err -> do
               forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"=== chunk ===\n" forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
decodeLocale ByteString
chunk forall a. [a] -> [a] -> [a]
++ [Char]
"\n=== end chunk ===="
               forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Error parsing stream. " forall a. [a] -> [a] -> [a]
++ [Char]
err forall a. [a] -> [a] -> [a]
++ [Char]
"\nContext: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
ctx

decodePath :: BC.ByteString -> AnchoredPath
decodePath :: ByteString -> AnchoredPath
decodePath = [Char] -> AnchoredPath
floatPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
decodeLocale