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 = Marks
forall a. IntMap a
M.empty

lastMark :: Marks -> Int
lastMark :: Marks -> Int
lastMark Marks
m = if Marks -> Bool
forall a. IntMap a -> Bool
M.null Marks
m then Int
0 else (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int) -> (Int, ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ Marks -> (Int, ByteString)
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 = Int -> Marks -> Maybe ByteString
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 = Int -> ByteString -> Marks -> Marks
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' (ByteString -> [ByteString]) -> IO ByteString -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO ByteString
BC.readFile FilePath
p
                 Marks -> IO Marks
forall (m :: * -> *) a. Monad m => a -> m a
return (Marks -> IO Marks) -> Marks -> IO Marks
forall a b. (a -> b) -> a -> b
$ (Marks -> ByteString -> Marks) -> Marks -> [ByteString] -> Marks
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Marks -> ByteString -> Marks
merge Marks
forall a. IntMap a
M.empty [ByteString]
lines'
               IO Marks -> IO Marks -> IO Marks
forall a. IO a -> IO a -> IO a
`catchall` Marks -> IO Marks
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] -> Int -> ByteString -> Marks -> Marks
forall a. Int -> a -> IntMap a -> IntMap a
M.insert (FilePath -> Int
forall a. Read a => FilePath -> a
read (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BC.unpack ByteString
i) ((Char -> Bool) -> ByteString -> ByteString
BC.dropWhile (Char -> Char -> Bool
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 IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchall` () -> IO ()
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 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Int, ByteString) -> ByteString)
-> [(Int, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ByteString) -> ByteString
forall a. Show a => (a, ByteString) -> ByteString
format ([(Int, ByteString)] -> [ByteString])
-> [(Int, ByteString)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Marks -> [(Int, ByteString)]
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 (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> FilePath
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 :: PatchInfoAnd rt p cX cY -> ByteString
patchHash PatchInfoAnd rt p cX cY
p = FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ SHA1 -> FilePath
forall a. Show a => a -> FilePath
show (SHA1 -> FilePath) -> SHA1 -> FilePath
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname (PatchInfoAnd rt p cX cY -> PatchInfo
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 PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> 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