#include "gadts.h"
module Darcs.Repository.LowLevel
( readPending, readTentativePending
, writeTentativePending
, readNewPending, writeNewPending
, pendingName )
where
import Darcs.Repository.InternalTypes ( RepoType(..), Repository(..) )
import Darcs.Patch ( readPatch, writePatch, RepoPatch, PrimOf )
import Darcs.Patch.Read ( ReadPatch(..), bracketedFL )
import Darcs.Patch.ReadMonads ( ParserM )
import Darcs.Patch.Show ( ShowPatchBasic(..) )
import Darcs.Global ( darcsdir )
import Darcs.Witnesses.Sealed ( Sealed(Sealed), mapSeal )
import Darcs.Witnesses.Ordered ( FL(..), mapFL )
import Darcs.Utils ( catchall )
import ByteStringUtils ( gzReadFilePS )
import Printer ( Doc, ($$), text, vcat )
import Control.Applicative
import qualified Data.ByteString as BS ( ByteString, empty )
pendingName :: RepoType p -> String
pendingName (DarcsRepository _ _) = darcsdir++"/patches/pending"
readPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL (PrimOf p) C(t)))
readPending (Repo _ _ _ tp) =
readPendingFile (pendingName tp)
readTentativePending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL (PrimOf p) C(t)))
readTentativePending (Repo _ _ _ tp) =
readPendingFile (pendingName tp ++ ".tentative")
readNewPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL (PrimOf p) C(t)))
readNewPending (Repo _ _ _ tp) =
readPendingFile (pendingName tp ++ ".new")
readPendingFile :: ReadPatch prim => String -> IO (Sealed (FL prim C(x)))
readPendingFile name = do
pend <- gzReadFilePS name `catchall` return BS.empty
return $ readPendingContents pend
newtype FLM p C(x y) = FLM { unFLM :: FL p C(x y) }
instance ReadPatch p => ReadPatch (FLM p) where
readPatch' = mapSeal FLM <$> readMaybeBracketedFL readPatch' '{' '}'
instance ShowPatchBasic p => ShowPatchBasic (FLM p) where
showPatch = showMaybeBracketedFL showPatch '{' '}' . unFLM
readPendingContents :: ReadPatch prim => BS.ByteString -> Sealed (FL prim C(x))
readPendingContents = maybe (Sealed NilFL) (mapSeal unFLM) . readPatch
writePendingFile :: ShowPatchBasic prim => String -> FL prim C(x y) -> IO ()
writePendingFile name = writePatch name . FLM
readMaybeBracketedFL :: forall m p C(x) . ParserM m =>
(FORALL(y) m (Sealed (p C(y)))) -> Char -> Char -> m (Sealed (FL p C(x)))
readMaybeBracketedFL parser pre post =
bracketedFL parser pre post <|> (mapSeal (:>:NilFL) <$> parser)
showMaybeBracketedFL :: (FORALL(x y) p C(x y) -> Doc) -> Char -> Char -> FL p C(a b) -> Doc
showMaybeBracketedFL _ pre post NilFL = text [pre] $$ text [post]
showMaybeBracketedFL printer _ _ (p :>: NilFL) = printer p
showMaybeBracketedFL printer pre post ps = text [pre] $$ vcat (mapFL printer ps) $$ text [post]
writeTentativePending :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(t y) -> IO ()
writeTentativePending (Repo _ _ _ tp) pend =
writePendingFile (pendingName tp ++ ".tentative") pend
writeNewPending :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(t y) -> IO ()
writeNewPending (Repo _ _ _ tp) pend =
writePendingFile (pendingName tp ++ ".new") pend