Florent Becker <[email protected]> added the comment: Here is the review for the 5 first patches
Show instance for RL -------------------- Ganesh Sittampalam <[email protected]>**20101017084445 hunk ./src/Darcs/Witnesses/Ordered.hs 97 > instance Show2 a => Show2 (FL a) where > showDict2 = ShowDictClass > > +instance Show2 a => Show (RL a C(x z)) where > + showsPrec _ NilRL = showString "NilRL" > + showsPrec d (x :<: xs) = showParen (d > prec) $ showsPrec2 (prec + 1) x . > + showString " :<: " . showsPrec (prec + 1) xs > + where prec = 5 > + > +instance Show2 a => Show1 (RL a C(x)) where > + showDict1 = ShowDictClass > + > +instance Show2 a => Show2 (RL a) where > + showDict2 = ShowDictClass > + > -- reverse list > data RL a C(x z) where > (:<:) :: a C(y z) -> RL a C(x y) -> RL a C(x z) Ok simplify showContextHunk ------------------------ Ganesh Sittampalam <[email protected]>**20101014060330 hunk ./src/Darcs/Patch/V1/Viewing.hs 20 > > instance ShowPatch Patch where > showPatch = showPatch_ > - showContextPatch (PP x) | primIsHunk x = showContextHunk (PP x) > + showContextPatch (PP x) | primIsHunk x = showContextHunk x > showContextPatch (ComP NilFL) = return $ blueText "{" $$ blueText "}" > showContextPatch (ComP ps) = > do x <- showContextSeries ps hunk ./src/Darcs/Patch/Viewing.hs 91 > return $ a $$ fst b > scs _ NilFL = return empty > > -showContextHunk :: (Apply p, ShowPatch p, Effect p) => p C(x y) -> TreeIO Doc > -showContextHunk p = case isHunk p of > - Just h -> coolContextHunk identity h identity > - Nothing -> return $ showPatch p > +-- |Thist must only be called with a hunk patch > +showContextHunk :: Prim C(x y) -> TreeIO Doc > +showContextHunk h = coolContextHunk identity h identity > > coolContextHunk :: Prim C(a b) -> Prim C(b c) -> Prim C(c d) -> TreeIO Doc > coolContextHunk prev p@(FP f (Hunk l o n)) next = do Ok relax type of bracketedFL ------------------------- Ganesh Sittampalam <[email protected]>**20101014174748 Remove useless (ReadPatch p) constraint hunk ./src/Darcs/Patch/Read.hs 82 > return $ Just $ Sealed $ reverseFL fl > > {-# INLINE bracketedFL #-} > -bracketedFL :: forall p m C(x) . (ReadPatch p, ParserM m) => > +bracketedFL :: forall p m C(x) . (ParserM m) => > (FORALL(y) m (Maybe (Sealed (p C(y))))) -> Char -> Char -> m (Maybe (Sealed (FL p C(x)))) > bracketedFL parser pre post = > peekforc pre bfl (return Nothing) ok Clean up pending API a bit -------------------------- Ganesh Sittampalam <[email protected]>**20101014174838 hunk ./src/Darcs/Repository/Internal.hs 56 hunk ./src/Darcs/Repository/Internal.hs 77 hunk ./src/Darcs/Repository/Internal.hs 106 hunk ./src/Darcs/Repository/Internal.hs 118 [imports] hunk ./src/Darcs/Repository/Internal.hs 313 > do let newname = pendingName tp ++ ".new" > debugMessage $ "Writing new pending: " ++ newname > Sealed sfp <- return $ siftForPending origp > - writeSealedPatch newname $ seal $ fromPrims $ sfp > + writePendingFile newname sfp > cur <- readRecorded repo > Sealed p <- readPendingfile newname > catch (applyToTree p cur) $ \err -> do hunk ./src/Darcs/Repository/Internal.hs 325 > $$ text "along with a bug report." > renameFile newname (pendingName tp) > debugMessage $ "Finished writing new pending: " ++ newname > - where writeSealedPatch :: FilePath -> Sealed (Patch C(x)) -> IO () > - writeSealedPatch fp (Sealed p) = writePatch fp p > > siftForPending :: FL Prim C(x y) -> Sealed (FL Prim C(x)) > siftForPending simple_ps = Stop reimplementing writePendingFile hunk ./src/Darcs/Repository/Internal.hs 384 > handlePendForAdd :: forall p q C(r u t x y). (RepoPatch p, Effect q) > => Repository p C(r u t) -> q C(x y) -> IO () > handlePendForAdd (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return () > -handlePendForAdd (Repo _ _ _ rt) p = > - do let pn = pendingName rt ++ ".tentative" > - Sealed pend <- (readPrims `fmap` gzReadFilePS pn) `catchall` (return $ Sealed NilFL) > +handlePendForAdd repo p = > + do > + Sealed pend <- readTentativePending repo > let effectp = if allFL isSimple pend then crudeSift $ effect p > else effect p Stop reimplementing readTentativePending hunk ./src/Darcs/Repository/Internal.hs 389 > - Sealed newpend <- return $ rmpend (progressFL "Removing from pending:" effectp) pend > - writePatch pn $ fromPrims_ newpend > + Sealed newpend <- return $ rmpend (progressFL "Removing from pending:" effectp) (unsafeCoercePStart pend) > + writeTentativePending repo (unsafeCoercePStart newpend) > where rmpend :: FL Prim C(a b) -> FL Prim C(a c) -> Sealed (FL Prim C(b)) > rmpend NilFL x = Sealed x > rmpend _ NilFL = Sealed NilFL See above hunk ./src/Darcs/Repository/Internal.hs 406 > -- reached, but it also > -- shouldn't lead to > -- corruption. > - fromPrims_ :: FL Prim C(a b) -> Patch C(a b) > - fromPrims_ = fromPrims > > isSimple :: Prim C(x y) -> Bool > isSimple x = primIsHunk x || primIsBinary x || primIsSetpref x No longer needed hunk ./src/Darcs/Repository/Internal.hs 503 > tentativelyAddToPending (Repo _ opts _ _) _ _ > | NoUpdateWorking `elem` opts = return () > | DryRun `elem` opts = bug "tentativelyAddToPending called when - -dry-run is specified" > -tentativelyAddToPending (Repo dir _ _ rt) _ patch = > +tentativelyAddToPending repo@(Repo dir _ _ _) _ patch = > withCurrentDirectory dir $ do hunk ./src/Darcs/Repository/Internal.hs 505 > - let pn = pendingName rt > - tpn = pn ++ ".tentative" > - Sealed pend <- readPrims `liftM` (gzReadFilePS tpn `catchall` (return B.empty)) > + Sealed pend <- readTentativePending repo > FlippedSeal newpend_ <- return $ newpend (unsafeCoerceP pend :: FL Prim C(a x)) patch ibidem hunk ./src/Darcs/Repository/Internal.hs 507 > - writePatch tpn $ fromPrims_ newpend_ > + writeTentativePending repo (unsafeCoercePStart newpend_) > where newpend :: FL Prim C(a b) -> FL Prim C(b c) -> FlippedSeal (FL Prim) C(c) > newpend NilFL patch_ = flipSeal patch_ > newpend p patch_ = flipSeal $ p +>+ patch_ Why seal then coerce, rather than coerce directly? hunk ./src/Darcs/Repository/Internal.hs 511 > - fromPrims_ :: FL Prim C(a b) -> Patch C(a b) > - fromPrims_ = fromPrims > > -- | setTentativePending is basically unsafe. It overwrites the pending state with a new one, not related to > -- the repository state. No longer needed, thanks to readTentativePending hunk ./src/Darcs/Repository/Internal.hs 516 > setTentativePending :: forall p C(r u t x y). RepoPatch p => Repository p C(r u t) -> FL Prim C(x y) -> IO () > setTentativePending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return () > -setTentativePending (Repo dir _ _ rt) patch = do > +setTentativePending repo@(Repo dir _ _ _) patch = do > Sealed prims <- return $ siftForPending patch hunk ./src/Darcs/Repository/Internal.hs 518 > - withCurrentDirectory dir $ > - writePatch (pendingName rt ++ ".tentative") $ fromPrims_ prims > - where fromPrims_ :: FL Prim C(a b) -> Patch C(a b) > - fromPrims_ = fromPrims > + withCurrentDirectory dir $ writeTentativePending repo (unsafeCoercePStart prims) > > -- | prepend is basically unsafe. It overwrites the pending state > -- with a new one, not related to the repository state. as above hunk ./src/Darcs/Repository/Internal.hs 525 > prepend :: forall p C(r u t x y). RepoPatch p => > Repository p C(r u t) -> FL Prim C(x y) -> IO () > prepend (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return () > -prepend (Repo _ _ _ rt) patch = > - do let pn = pendingName rt ++ ".tentative" > - Sealed pend <- readPrims `liftM` (gzReadFilePS pn `catchall` (return B.empty)) > - Sealed newpend_ <- return $ newpend pend patch > - writePatch pn $ fromPrims_ (crudeSift newpend_) > +prepend repo@(Repo _ _ _ _) patch = > + do > + Sealed pend <- readTentativePending repo > + Sealed newpend_ <- return $ newpend (unsafeCoerceP pend) patch > + writeTentativePending repo (unsafeCoercePStart $ crudeSift newpend_) > where newpend :: FL Prim C(b c) -> FL Prim C(a b) -> Sealed (FL Prim C(a)) > newpend NilFL patch_ = seal patch_ > newpend p patch_ = seal $ patch_ +>+ p as above, why seal then coerce? What's more, there are unsafeCoerces because of the function's unsafety. On the other hand, prepend is called only once, with x = t. Shouldn't it be reflected in its type, and wouldn't it reduce the need for unsafeCoerces? hunk ./src/Darcs/Repository/Internal.hs 533 > - fromPrims_ :: FL Prim C(a b) -> Patch C(a b) > - fromPrims_ = fromPrims > > tentativelyRemovePatches :: RepoPatch p => Repository p C(r u t) -> Compression > -> FL (PatchInfoAnd p) C(x t) -> IO (Repository p C(r u x)) ok hunk ./src/Darcs/Repository/Internal.hs 570 > finalizePending (Repo dir opts _ rt) > | NoUpdateWorking `elem` opts = > withCurrentDirectory dir $ removeFileMayNotExist $ (pendingName rt) > -finalizePending repository@(Repo dir _ _ rt) = do > - withCurrentDirectory dir $ do let pn = pendingName rt > - tpn = pn ++ ".tentative" > - tpfile <- gzReadFilePS tpn `catchall` (return B.empty) > - Sealed tpend <- return $ readPrims tpfile > +finalizePending repository@(Repo dir _ _ _) = do > + withCurrentDirectory dir $ do > + Sealed tpend <- readTentativePending repository > Sealed new_pending <- return $ siftForPending tpend > makeNewPending repository new_pending > idem, we stop reinventing the wheel replace ./src/Darcs/Repository/Internal.hs [A-Za-z_0-9] readPendingfile readPendingFile replace ./src/Darcs/Repository/Internal.hs [A-Za-z_0-9] readPrims readPendingContents clearer hunk ./src/Darcs/Repository/LowLevel.hs 23 > > #include "gadts.h" > > -module Darcs.Repository.LowLevel ( readPending, readPendingfile, pendingName, readPrims ) where > +module Darcs.Repository.LowLevel > + ( readPending, readTentativePending > + , writeTentativePending > + -- deprecated interface: > + , readPendingfile, writePendingFile > + , pendingName ) > + where > > import Darcs.Repository.InternalTypes ( RepoType(..), Repository(..) ) Would it be possible to tell hlint that these functions are deprecated? hunk ./src/Darcs/Repository/LowLevel.hs 32 > -import Darcs.Patch ( readPatch, Prim, RepoPatch, effect ) > +import Darcs.Patch ( readPatch, writePatch, Prim, effect, fromPrims ) > import Darcs.Patch.V1 ( Patch ) -- needed for readPrims > import Darcs.Global ( darcsdir ) > import Darcs.Witnesses.Sealed ( Sealed(Sealed) ) hunk ./src/Darcs/Repository/LowLevel.hs 37 > import Darcs.Witnesses.Ordered ( FL(..) ) > -import Darcs.Utils ( catchall, withCurrentDirectory ) > +import Darcs.Utils ( catchall ) > import ByteStringUtils ( gzReadFilePS ) > import qualified Data.ByteString as BS ( ByteString, empty ) > hunk ./src/Darcs/Repository/LowLevel.hs 44 > pendingName :: RepoType p -> String > pendingName (DarcsRepository _ _) = darcsdir++"/patches/pending" > > -readPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL Prim C(t))) > -readPending (Repo r _ _ tp) = > - withCurrentDirectory r (readPendingfile (pendingName tp)) > +-- | Read the contents of pending. CWD should be the repository directory. > +-- The return type is currently incorrect as it refers to the tentative > +-- state rather than the recorded state. > +readPending :: Repository p C(r u t) -> IO (Sealed (FL Prim C(t))) > +readPending (Repo _ _ _ tp) = > + readPendingfile (pendingName tp) > + > +-- |Read the contents of tentative pending. CWD should be the repository directory. > +readTentativePending :: Repository p C(r u t) -> IO (Sealed (FL Prim C(t))) > +readTentativePending (Repo _ _ _ tp) = > + readPendingfile (pendingName tp ++ ".tentative") > > readPendingfile :: String -> IO (Sealed (FL Prim C(x))) > readPendingfile name = do darcs does not compile if we correct the type of readPending. Does that means (potential) bugs? hunk ./src/Darcs/Repository/LowLevel.hs 65 > readPrims s = case readPatch s :: Maybe (Sealed (Patch C(x )), BS.ByteString) of > Nothing -> Sealed NilFL > Just (Sealed p,_) -> Sealed (effect p) > - hunk ./src/Darcs/Repository/LowLevel.hs 66 > +writePendingFile :: String -> FL Prim C(x y) -> IO () > +writePendingFile name pend = writePatch name $ fromPrims_ pend > + where fromPrims_ :: FL Prim C(a b) -> Patch C(a b) > + fromPrims_ = fromPrims > + > +-- |Read the contents of tentative pending. CWD should be the repository directory. > +writeTentativePending :: Repository p C(r u t) -> FL Prim C(t y) -> IO () > +writeTentativePending (Repo _ _ _ tp) pend = > + writePendingFile (pendingName tp ++ ".tentative") pend s/-- |Read/-- |Write/ replace ./src/Darcs/Repository/LowLevel.hs [A-Za-z_0-9] readPendingfile readPendingFile replace ./src/Darcs/Repository/LowLevel.hs [A-Za-z_0-9] readPrims readPendingContents ok stop using Patch instances for reading/writing pending ------------------------------------------------------ Ganesh Sittampalam <[email protected]>**20101014202717 hunk ./src/Darcs/Repository/LowLevel.hs 32 hunk ./src/Darcs/Repository/LowLevel.hs 37 hunk ./src/Darcs/Repository/LowLevel.hs 41 [imports] hunk ./src/Darcs/Repository/LowLevel.hs 67 > pend <- gzReadFilePS name `catchall` return BS.empty > return $ readPendingContents pend > > +-- Wrapper around FL where printed format uses { } except around singletons > +newtype FLM p C(x y) = FLM { unFLM :: FL p C(x y) } > + > +instance ReadPatch p => ReadPatch (FLM p) where > + readPatch' want_eof = > + do res <- fmap (mapSeal FLM) <$> readMaybeBracketedFL (readPatch' False) '{' '}' > + when want_eof lexEof > + return res > + > +instance ShowPatch p => ShowPatch (FLM p) where > + showPatch = showMaybeBracketedFL showPatch '{' '}' . unFLM > + > readPendingContents :: BS.ByteString -> Sealed (FL Prim C(x)) ok hunk ./src/Darcs/Repository/LowLevel.hs 80 > -readPendingContents s = case readPatch s :: Maybe (Sealed (Patch C(x )), BS.ByteString) of > - Nothing -> Sealed NilFL > - Just (Sealed p,_) -> Sealed (effect p) > +readPendingContents = maybe (Sealed NilFL) (mapSeal unFLM . fst) . readPatch > > writePendingFile :: String -> FL Prim C(x y) -> IO () ok hunk ./src/Darcs/Repository/LowLevel.hs 83 > -writePendingFile name pend = writePatch name $ fromPrims_ pend > - where fromPrims_ :: FL Prim C(a b) -> Patch C(a b) > - fromPrims_ = fromPrims > +writePendingFile name = writePatch name . FLM > + > +readMaybeBracketedFL :: forall m p C(x) . ParserM m => > + (FORALL(y) m (Maybe (Sealed (p C(y))))) -> Char -> Char -> m (Maybe (Sealed (FL p C(x)))) > +readMaybeBracketedFL parser pre post = > + do mps <- bracketedFL parser pre post > + case mps of > + Just res -> return (Just res) > + Nothing -> fmap (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] > > -- |Read the contents of tentative pending. CWD should be the repository directory. > writeTentativePending :: Repository p C(r u t) -> FL Prim C(t y) -> IO () Ok ---------- assignedto: -> galbolle nosy: +galbolle __________________________________ Darcs bug tracker <[email protected]> <http://bugs.darcs.net/patch421> __________________________________ _______________________________________________ darcs-users mailing list [email protected] http://lists.osuosl.org/mailman/listinfo/darcs-users
