module Darcs.UI.Commands.Convert.Util
    ( Marks
    , emptyMarks
    , addMark
    , getMark
    , lastMark
    , readMarks
    , writeMarks
    -- misc
    , patchHash
    , updatePending
    ) where

import Darcs.Prelude

import Darcs.Util.Exception ( catchall )

import qualified Data.ByteString.Char8 as BC
import qualified Data.IntMap as M

import System.Directory ( removeFile )

import Darcs.Patch.Info ( makePatchname )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )

import Darcs.Repository.Flags ( UpdatePending(..) )
import Darcs.UI.Options ( (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.Flags ( DarcsFlag )

-- marks support

type Marks = M.IntMap BC.ByteString

emptyMarks :: Marks
emptyMarks :: Marks
emptyMarks = forall a. IntMap a
M.empty

lastMark :: Marks -> Int
lastMark :: Marks -> Int
lastMark Marks
m = if forall a. IntMap a -> Bool
M.null Marks
m then Int
0 else forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> (Int, a)
M.findMax Marks
m

getMark :: Marks -> Int -> Maybe BC.ByteString
getMark :: Marks -> Int -> Maybe ByteString
getMark Marks
marks Int
key = forall a. Int -> IntMap a -> Maybe a
M.lookup Int
key Marks
marks

addMark :: Marks -> Int -> BC.ByteString -> Marks
addMark :: Marks -> Int -> ByteString -> Marks
addMark Marks
marks Int
key ByteString
value = forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
key ByteString
value Marks
marks

readMarks :: FilePath -> IO Marks
readMarks :: FilePath -> IO Marks
readMarks FilePath
p = do [ByteString]
lines' <- Char -> ByteString -> [ByteString]
BC.split Char
'\n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO ByteString
BC.readFile FilePath
p
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Marks -> ByteString -> Marks
merge forall a. IntMap a
M.empty [ByteString]
lines'
               forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return Marks
emptyMarks
  where merge :: Marks -> ByteString -> Marks
merge Marks
set ByteString
line = case Char -> ByteString -> [ByteString]
BC.split Char
':' ByteString
line of
          [ByteString
i, ByteString
hash] -> forall a. Int -> a -> IntMap a -> IntMap a
M.insert (forall a. Read a => FilePath -> a
read forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BC.unpack ByteString
i) ((Char -> Bool) -> ByteString -> ByteString
BC.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
hash) Marks
set
          [ByteString]
_ -> Marks
set -- ignore, although it is maybe not such a great idea...

writeMarks :: FilePath -> Marks -> IO ()
writeMarks :: FilePath -> Marks -> IO ()
writeMarks FilePath
fp Marks
m = do FilePath -> IO ()
removeFile FilePath
fp forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return () -- unlink
                     FilePath -> ByteString -> IO ()
BC.writeFile FilePath
fp ByteString
marks
  where marks :: ByteString
marks = [ByteString] -> ByteString
BC.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, ByteString) -> ByteString
format forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, a)]
M.assocs Marks
m
        format :: (a, ByteString) -> ByteString
format (a
k, ByteString
s) = [ByteString] -> ByteString
BC.concat [FilePath -> ByteString
BC.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show a
k, FilePath -> ByteString
BC.pack FilePath
": ", ByteString
s, FilePath -> ByteString
BC.pack FilePath
"\n"]

-- misc shared functions

patchHash :: PatchInfoAnd rt p cX cY -> BC.ByteString
patchHash :: forall (rt :: RepoType) (p :: * -> * -> *) cX cY.
PatchInfoAnd rt p cX cY -> ByteString
patchHash PatchInfoAnd rt p cX cY
p = FilePath -> ByteString
BC.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p cX cY
p)

updatePending :: [DarcsFlag] -> UpdatePending
updatePending :: [DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts =
  case PrimDarcsOption WithWorkingDir
O.withWorkingDir forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
    WithWorkingDir
O.WithWorkingDir -> UpdatePending
YesUpdatePending
    WithWorkingDir
O.NoWorkingDir -> UpdatePending
NoUpdatePending