{-# LANGUAGE PatternGuards, ScopedTypeVariables #-} module DPM.UI.Commandline.Commands ( addPatchBundle, applyPatch, reviewPatch, listPatches, sync, markAsReviewed, markAsUndecided, markAsObsolete, markAsRejected, openGroup, closeGroup, addComment, viewPatch, exportBundle, markAsApplied, markAsUnapplied ) where import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Control.Monad import Control.Monad.Trans import qualified Data.List as List import qualified Text.PrettyPrint as PP import System.Directory import System.IO import Text.PrettyPrint import ByteStringUtils ( gzReadFilePS ) -- from darcs import Data.Time ( UTCTime, getCurrentTime ) import DPM.Core.DataTypes import DPM.Core.QueryParser import DPM.Core.DPM_Monad import DPM.Core.Email import qualified DPM.Core.PatchBundleParser as PBP import DPM.Core.Conflicts import DPM.Core.ReverseDependencies import qualified DPM.Core.Darcs as Darcs import qualified DPM.Core.Storage as S import DPM.Core.Utils import DPM.Core.ShortID import DPM.UI.Commandline.Interaction import DPM.UI.Commandline.CDPM_Monad import qualified DPM.UI.Commandline.ANSIColors as Colors -- -- Commands -- addPatchBundle :: String -> B.ByteString -> CDPM () addPatchBundle origin bs = withLock $ do info ("About to add patches from bundle " ++ show origin) repoDir <- getDPMConfigValue cfg_repoDir -- existing <- getAllUnapplied darcsRes <- liftIO $ Darcs.readPatchBundle repoDir bs -- existing case darcsRes of Left err -> darcsFailed err Right content -> let patches = Darcs.pbc_patches content conflicts = Darcs.pbc_conflicts content in if null patches then info ("All patches in " ++ origin ++ " have already been applied.") else do bname <- liftDPM $ S.addPatchBundle $ readDarcsEmail bs mapM_ (\p -> addPatch repoDir p bname conflicts) patches where addPatch repoDir p bname conflicts = do conflictWithRepo <- liftIO $ Darcs.conflictsBundleWithRepo repoDir bs let c = lookupConflicts (p_id p) conflicts liftDPM $ S.addPatch p bname c conflictWithRepo info ("Added patch\n" ++ show (nest 2 (renderPatchNameShort p))) getAllUnapplied = do result <- liftDPM $ S.getPatches (QNot (QState PatchStateAPPLIED)) liftIO $ mapM (\(p,fp) -> do s <- B.readFile fp return $ PatchData (p_id p) s) (concatMap pg_patches (S.pr_groups result)) lookupConflicts pid conflicts = case List.lookup pid conflicts of Nothing -> [] Just c -> c data ExtraInfo = ExtraInfo { ei_revDeps :: PatchRevDeps , ei_conflicts :: PatchConflicts } listPatches :: Query -> CDPM () listPatches query = do result <- liftDPM $ S.getPatches query cfg <- getConfig let sorted = sortPatchGroups (map (\pg -> pg { pg_patches = sortPGMembers (pg_patches pg) }) (S.pr_groups result)) render sorted (S.pr_allPatchIDs result) cfg (ExtraInfo (S.pr_revDeps result) (S.pr_allConflicts result)) where sortPatchGroups :: [PatchGroup (Patch, FilePath)] -> [PatchGroup (Patch, FilePath)] sortPatchGroups pgs = flip List.sortBy pgs (\pg1 pg2 -> case (pg_state pg1, pg_state pg2) of (PatchGroupOpen, PatchGroupClosed) -> LT (PatchGroupClosed, PatchGroupOpen) -> GT _ -> case (pg_patches pg1, pg_patches pg2) of ((p1,_):_, (p2,_):_) -> p_date p2 `compare` p_date p1 _ -> EQ) sortPGMembers :: [(Patch, FilePath)] -> [(Patch, FilePath)] sortPGMembers members = flip List.sortBy members (\(p1,_) (p2,_) -> case () of _| p_state p1 `elem` [PatchStateUNDECIDED, PatchStateAPPLIED] -> LT | p_state p2 `elem` [PatchStateUNDECIDED, PatchStateAPPLIED] -> GT | otherwise -> -- most recent patch comes first p_date p2 `compare` p_date p1) render matching allIDs cfg conflicts = if null matching then liftIO $ putStrLn ("(no matches)") else liftIO $ putStrLn (PP.render (foldr (\g d -> renderPatchGroup allIDs cfg conflicts g $$ d) empty matching)) applyPatch :: Bool -> String -> CDPM () applyPatch interactive s = do allPIDs <- liftDPM S.allPatchIDs applyPatch' allPIDs s where applyPatch' allIDs shortPID = do pid <- resolvePID allIDs shortPID p <- getPatch pid case p_state p of (PatchStateDISCARDED reason) -> abort ("Patch " ++ shortPID ++ " is in state " ++ show (prettyReason reason) ++ ".") PatchStateAPPLIED -> info ("Patch " ++ shortPID ++ " is in state APPLIED, " ++ "nothing to do") PatchStateUNDECIDED -> do unless (isReviewed p) $ do b <- query_yN ("Patch " ++ shortPID ++ " not reviewed. Shall I " ++ "nevertheless apply it? ") when (not b) userAbort mapM_ checkDependency (p_dependents p) info ("About to apply patch " ++ shortPID) let patchName = renderPatchName p f <- liftDPM $ S.getPatchFile pid -- it would be better to take the lock while -- performing the darcs apply command. However, -- this may take a long time, so we do not take -- the lock here but later darcsApply patchName pid f liftDPM $ S.withLock $ S.markAsApplied pid "-" do info ("Patch " ++ shortPID ++ " applied successfully") send <- query_Yn ("Send notification to author " ++ p_author p ++ " of patch " ++ shortPID ++ "? ") when send $ liftDPM $ sendEmailSimple p "applied" where darcsApply patchName patchID fname = do repoDir <- getDPMConfigValue cfg_repoDir color3 <- getConfigValue cfg_color3 runTests <- getConfigValue cfg_tests runTests' <- if (not runTests) then do b <- query_yN "Will not run any tests. Sure? " return (not b) else return True -- info (Colors.colored color3 ++ "[start darcs]") res <- liftIO $ Darcs.apply repoDir patchName patchID runTests' interactive fname -- info ("[end darcs]" ++ Colors.colored Colors.Reset) case res of Left err -> darcsFailed err Right () -> return () checkDependency pid' = do p <- getPatch pid' case p_state p of PatchStateAPPLIED -> return () PatchStateUNDECIDED -> do b <- query_Yn ("Patch " ++ shortPID ++ " depends on patch " ++ getShortID allIDs pid' ++ ". Apply patch " ++ getShortID allIDs pid' ++ " first? ") if not b then userAbort else applyPatch' allIDs (getShortID allIDs pid') PatchStateDISCARDED reason -> do abort ("Patch " ++ shortPID ++ " depends on patch " ++ getShortID allIDs pid' ++ ", which is marked as " ++ show (prettyReason reason) ++ ".") reviewPatch :: String -> CDPM () reviewPatch shortPID = do batch <- getConfigValue cfg_batch force <- getConfigValue cfg_force info ("Reviewing patch " ++ shortPID) allPIDs <- liftDPM $ S.allPatchIDs pid <- resolvePID allPIDs shortPID doReview force allPIDs pid shortPID where doReview force allPIDs pid shortPID = do p <- getPatch pid case () of _| p_state p == PatchStateAPPLIED -> info "Refusing to offer an already applied patch for review." | isReviewed p && not force -> info ("Patch " ++ shortPID ++ " already reviewed, nothing to do.") | otherwise -> do if isDiscarded (p_state p) then do b <- query_yN ("Really review patch " ++ shortPID ++ ", which is in state " ++ show (prettyPatchState (p_state p)) ++ "? ") if b then reallyReview force allPIDs pid shortPID p else return () else reallyReview force allPIDs pid shortPID p reviewDependent force allPIDs parentShortPID pid = do p <- getPatch pid if isReviewed p || p_state p == PatchStateAPPLIED then return False else do let shortPID = getShortID allPIDs pid discardedWarning = if isDiscarded (p_state p) then (", which is in state " ++ show (prettyPatchState (p_state p))) else "" b <- query_Yn ("Patch " ++ parentShortPID ++ " depends on patch " ++ shortPID ++ discardedWarning ++ ". Review patch " ++ shortPID ++ " first? ") when b $ reallyReview force allPIDs pid shortPID p return b reallyReview force allPIDs pid shortPID p = do bs <- mapM (reviewDependent force allPIDs shortPID) (p_dependents p) when (or bs) $ do wait ("Press ENTER to continue with review of patch " ++ shortPID ++ ". ") fname <- liftDPM $ S.getPatchFile pid bracketCDPM (do tmpDir <- getDPMConfigValue cfg_reviewDir user <- getDPMConfigValue cfg_currentUser liftIO $ do patchData <- gzReadFilePS fname time <- getCurrentTime let formattedTime = formatTime "%F" time (tmpFile, handle) <- openTempFile tmpDir (formattedTime ++ "_" ++ shortPID ++ "_" ++ user ++ "_" ++ ".dpatch") let infoDoc = (renderPatchName p) $$ (vcat $ map text (p_darcsLog p)) hPutStr handle (quote (show infoDoc)) hPutStrLn handle ">" cleaned <- cleanupBundle p patchData B.hPut handle (quoteBS cleaned) hPutStrLn handle "" hClose handle return tmpFile) (return $ return ()) -- do not remove (\tmpFile -> do editorCmd <- liftIO $ getEditorCommand info ("Starting editor on " ++ tmpFile) either <- liftIO $ execCommand editorCmd [tmpFile] case either of Left err -> abort err Right _ -> return () mr <- if not (isReviewed p) then query_Yn ("Mark patch " ++ shortPID ++ " as reviewed? ") else return False (md, mn) <- if p_state p == PatchStateUNDECIDED then do b <- query_yN ("Patch " ++ shortPID ++ " is in state UNDECIDED, " ++ "reject this patch? ") return (b, False) else do b <- query_yN ("Patch " ++ shortPID ++ " is " ++ show (prettyPatchState (p_state p)) ++ ", move it " ++ "to the UNDECIDED state? ") return (False, b) comment <- if mr || md || mn || force then query ("Enter a comment: ") "" else return "" withLock $ do when mr $ do liftDPM $ S.markAsReviewed pid comment info ("Marked patch " ++ shortPID ++ " as reviewed") when md $ do liftDPM $ S.markAsRejected pid comment info ("Moved patch " ++ shortPID ++ " to REJECTED state") when mn $ do liftDPM $ S.markAsUndecided pid comment info ("Moved patch " ++ shortPID ++ " to UNDECIDED state") from <- getDPMConfigValue cfg_fromAddress sentReview <- do reviewAddr <- getDPMConfigValue cfg_reviewAddress let to = case reviewAddr of Just s -> s Nothing -> p_author p queryFun = if md then query_Yn else query_yN send <- queryFun ("Send review to " ++ to ++ "? ") if not send then return False else do body <- liftIO $ readFile tmpFile liftIO $ sendEmail from to [] (tagSubject "reviewed" (Just (p_author p)) (unPatchGroupID (p_name p))) body [] return True when (not sentReview && (md || mn)) $ do send <- query_Yn ("Send notification to author " ++ p_author p ++ " of patch " ++ shortPID ++ "? ") let task = if md then "rejected" else "marked-as-undecided" when send $ liftDPM $ sendEmailSimple p task return ()) quote :: String -> String quote s = unlines $ map quoteLine $ lines s where quoteLine l = "> " ++ l quoteBS :: B.ByteString -> B.ByteString quoteBS bs = BC.unlines $ map quoteLine $ BC.lines bs where quoteLine = BC.append (BC.pack "> ") cleanupBundle :: MonadIO m => Patch -> B.ByteString -> m B.ByteString cleanupBundle p bs = case PBP.scanBundle bs of Left err -> do warn ("Reading patch bundle for patch " ++ show (p_id p) ++ " failed: " ++ err) return bs Right list -> case List.find (\(pi,_) -> patchMatches pi) list of Just (_, bs') -> return bs' Nothing -> do warn ("Patch " ++ show (p_id p) ++ " not found in bundle") return bs where -- dirty hack to work around missing/wrong IDs in patch bundles patchMatches pi = PBP.piName pi == unPatchGroupID (p_name p) && PBP.piAuthor pi == p_author p && PBP.piDate pi == formatTimeUTC darcsInternDateFormat (p_date p) {- Synchronzies DPM with the repository. The command changes only the state of patches and patch groups managed by DPM, it nevers adds new patches to DPM. -} -- FIXME: review and test -- FIXME: update information about which patches are in conflict with the repo sync :: CDPM () sync = do action <- asDPM doWork liftDPM $ S.withLock action where doWork = do repoDir <- getDPMConfigValue cfg_repoDir info "Getting all patches from repo ..." either <- liftIO $ Darcs.getPatchesInRepo repoDir patchesInRepo <- case either of Left err -> abort err Right l -> return l -- (1) -- Search for patches in the repo that are managed by DPM but which -- are not in state APPLIED. Then order these patches by dependency -- and mark them as APPLIED. info "Marking relevant patches as applied ..." allPatches <- liftDPM $ S.getPatches QTrue mapM_ (markAsApplied allPatches) (map sp_id patchesInRepo) -- (2) -- Search for patch names in the repo such that DPM manages an -- open patch group of the same name. Because step (1) did not -- close the patch group, it could be that the patch group -- should be closed. If in interactive mode, ask wether to close -- the patch group. If in batch mode, do not close the patch group -- but output a warning. info "Searching for closable groups ..." (searchResult, allIDs, conflicts) <- liftDPM $ do res <- S.getPatches (QGroupState PatchGroupOpen) ids <- S.allPatchIDs conflicts <- S.allConflicts return (res, ids, conflicts) let openGroups = S.pr_groups searchResult extraInfo = ExtraInfo (S.pr_revDeps searchResult) conflicts mapM_ (possiblyCloseGroup allIDs extraInfo openGroups) patchesInRepo info "Done." getPatch allPatches pid = let l = concatMap (\g -> map fst $ pg_patches g) (S.pr_groups allPatches) in List.find (\p -> p_id p == pid) l markAsApplied allPatches pid = do case getPatch allPatches pid of Nothing -> return () Just p -> when (p_state p /= PatchStateAPPLIED) $ do mapM_ (markAsApplied allPatches) (p_dependents p) changed <- liftDPM $ do when (isDiscarded (p_state p)) (S.markAsUndecided pid "required by sync" >> return ()) S.applyPatch pid (\_ -> return ()) (Just "required by sync") when changed $ info ("Patch " ++ unPatchID pid ++ " is already in the repository, " ++ "marked it as APPLIED.") possiblyCloseGroup allIDs extraInfo openGroups repoPatch = case List.find (\g -> pg_id g == sp_name repoPatch) openGroups of Nothing -> return () Just g -> do cfg <- getConfig let batch = cfg_batch cfg cfg' = cfg { cfg_verbose = True } groupStr = PP.render $ renderPatchGroup allIDs cfg' extraInfo g patchStr = PP.render $ renderSimplePatch repoPatch prefix = ("Repository contains the following patch:\n\n" ++ patchStr ++ "\n\nIn DPM, the following patch group " ++ "is open:\n\n" ++ groupStr ++ "\n") if batch then warn (prefix ++ "The group should possibly be closed.") else do info prefix b <- query_Yn "Shall the group be closed? " when b (withLock $ do liftDPM $ S.closePatchGroup (sp_name repoPatch) info ("Closed patch group of name " ++ show (unPatchGroupID (sp_name repoPatch)))) viewPatch :: String -> CDPM () viewPatch shortPID = do allPIDs <- liftDPM S.allPatchIDs pid <- resolvePID allPIDs shortPID fname <- liftDPM $ S.getPatchFile pid p <- getPatch pid patchData <- liftIO $ gzReadFilePS fname liftIO $ do hPutStrLn handle (show (renderPatchName p)) hPutStrLn handle "" debug "Cleaning up bundle..." cleaned <- liftIO $ cleanupBundle p patchData debug "Finished cleaning up bundle..." liftIO $ do B.hPut handle cleaned hPutStrLn handle "" where handle = stdout exportBundle :: String -> CDPM () exportBundle shortPID = do allPIDs <- liftDPM S.allPatchIDs pid <- resolvePID allPIDs shortPID fname <- liftDPM $ S.getPatchFile pid liftIO $ do patchData <- gzReadFilePS fname B.hPut handle patchData where handle = stdout openGroup :: String -> CDPM () openGroup name = do liftDPM $ S.withLock (S.openPatchGroup (PatchID name)) return () closeGroup :: String -> CDPM () closeGroup name = do liftDPM $ S.withLock (S.closePatchGroup (PatchGroupID name)) return () markAsReviewed :: String -> S.Comment -> CDPM () markAsReviewed = genericMark S.markAsReviewed markAsUndecided :: String -> S.Comment -> CDPM () markAsUndecided = genericMark S.markAsUndecided markAsRejected :: String -> S.Comment -> CDPM () markAsRejected = genericMark S.markAsRejected markAsObsolete :: String -> S.Comment -> CDPM () markAsObsolete = genericMark S.markAsObsolete markAsUnapplied :: String -> S.Comment -> CDPM () markAsUnapplied shortPID comment = do allPIDs <- liftDPM S.allPatchIDs pid <- resolvePID allPIDs shortPID p <- getPatch pid case p_state p of PatchStateAPPLIED -> do repo <- liftDPM $ getDPMConfigValue cfg_repoDir ans <- query_yN ("Are you sure that patch " ++ shortPID ++ " (" ++ unPatchGroupID (p_name p) ++ ") has really been " ++ "unapplied from repository " ++ repo ++ "? ") when ans $ do genericMark S.markAsObsoleteNoCheck shortPID ("mark-as-unapplied: " ++ comment) genericMark S.markAsUndecided shortPID ("mark-as-unapplied: " ++ comment) _ -> abort ("Patch " ++ shortPID ++ " is not in state APPLIED") markAsApplied :: String -> S.Comment -> CDPM () markAsApplied shortPID comment = do repo <- liftDPM $ getDPMConfigValue cfg_repoDir ans <- query_yN ("Are you sure that patch " ++ shortPID ++ " has really already been applied to repository " ++ repo ++ "? ") when ans $ genericMark S.markAsApplied shortPID ("mark-as-applied: " ++ comment) genericMark :: (PatchID -> S.Comment -> DPM Bool) -> String -> S.Comment -> CDPM () genericMark fun shortPID comment = do allIDs <- liftDPM S.allPatchIDs pid <- resolvePID allIDs shortPID liftDPM $ S.withLock $ fun pid comment return () addComment :: String -> S.Comment -> CDPM () addComment shortPID comment = do allIDs <- liftDPM S.allPatchIDs pid <- resolvePID allIDs shortPID liftDPM $ S.withLock $ S.addComment pid comment return () -- -- Auxiliaries -- moduleName :: String moduleName = "CPM.UI.Commandline.Commands" getPatch :: PatchID -> CDPM Patch getPatch pid = do x <- getPatchGen pid case x of Left err -> abort err Right p -> return p getPatchGen :: PatchID -> CDPM (Either String Patch) getPatchGen pid = do r <- liftDPM $ S.withLock $ S.getPatches (QPatchID (unPatchID pid)) let l = S.pr_groups r case l of [] -> return $ Left ("No patch with ID " ++ unPatchID pid) [pg] | [(p,_)] <- pg_patches pg -> return $ Right p _ -> do bug (moduleName ++ ".getPatchesGen: " ++ "Unexcepted result returned by getPatches: " ++ show l) resolvePID :: [PatchID] -> String -> CDPM PatchID resolvePID allIDs shortPID = do let matching = filter (\pid -> List.isSuffixOf shortPID (unPatchID pid)) allIDs case matching of [] -> abort ("No patch whose ID has " ++ show shortPID ++ " as its suffix") [pid] -> do when (shortPID /= unPatchID pid) $ debug ("Resolved short patch ID " ++ shortPID ++ " as full patch ID " ++ unPatchID pid) return pid l -> abort ("Short patch ID " ++ shortPID ++ " does not uniquely determine a full patch ID. " ++ "Possible candidates: " ++ List.intercalate ", " (map unPatchID l)) renderPatchGroup :: [PatchID] -> Config -> ExtraInfo -> PatchGroup (Patch, FilePath) -> Doc renderPatchGroup allIDs cfg extraInfo pg = nest 0 (colored2 cfg (text (unPatchGroupID (pg_id pg))) <+> brackets (text "State:" <+> renderPGState (pg_state pg)) $$ (foldr (\p d -> renderPatch allIDs cfg groupIDs extraInfo p $$ d) (if pg_complete pg then empty else colored1 cfg (text " ..."))) (map fst (pg_patches pg))) where groupIDs = map (p_id . fst) (pg_patches pg) renderPatch :: [PatchID] -> Config -> [PatchID] -> ExtraInfo -> Patch -> Doc renderPatch allIDs cfg idsInGroup extraInfo p = let shortID = getShortID allIDs (p_id p) in nest 2 (colored1 cfg (text shortID) <+> renderDate (p_date p) <+> text (p_author p) $$ nest (length shortID + 1) (text "State:" <+> renderPatchState (p_state p) <> comma <+> text "Reviewed:" <+> bool (isReviewed p) $$ (if conflictsWithRepo (ei_conflicts extraInfo) (p_id p) then text "CONFLICT WITH REPOSITORY" else empty) $$ renderDependents allIDs (p_dependents p) $$ renderRevDependents allIDs (p_id p) (ei_revDeps extraInfo) $$ renderConflicts allIDs (conflictsOf p) $$ renderShortLog (p_log p) $$ (if not (cfg_verbose cfg) then empty else text "Full-ID:" <+> text (unPatchID (p_id p)) $$ text "Inverted:" <+> bool (p_inverted p) $$ renderDarcsLog (p_darcsLog p) $$ renderLog (p_log p)))) where conflictsOf p = let all = getConflicts (ei_conflicts extraInfo) (p_id p) in List.nub $ filter (\x -> not (x `elem` idsInGroup)) all renderShortLog l | cfg_verbose cfg = empty | otherwise = case filter (not . isIrrelevantLogEntry) l of [] -> empty (entry:_) -> text (log_message entry) renderSimplePatch :: SimplePatch -> Doc renderSimplePatch p = nest 2 (renderDate (sp_date p) <+> text (sp_author p) $$ text "Full-ID:" <+> text (unPatchID (sp_id p)) $$ text "Inverted:" <+> bool (sp_inverted p)) renderPGState :: PatchGroupState -> Doc renderPGState PatchGroupOpen = text "OPEN" renderPGState PatchGroupClosed = text "CLOSED" renderDependents :: [PatchID] -> [PatchID] -> Doc renderDependents = renderDependentsGen "Requires" empty renderRevDependents :: [PatchID] -> PatchID -> PatchRevDeps -> Doc renderRevDependents allIDs pid revDeps = let list = getRevDeps revDeps pid n = getMaxChainLen revDeps pid hint = if n < 2 then empty else text "Length of max chain:" <+> int n in renderDependentsGen "Required by" hint allIDs list renderDependentsGen :: String -> Doc -> [PatchID] -> [PatchID] -> Doc renderDependentsGen _ _ allIDs [] = empty renderDependentsGen label last allIDs l = text label <> text ":" <+> nest 0 (foldr (\pid d -> text (getShortID allIDs pid) <> (if isEmpty d then empty else comma <+> d)) last l) renderConflicts :: [PatchID] -> [PatchID] -> Doc renderConflicts allIDs [] = empty renderConflicts allIDs l = text "Conflicts with: " <> nest 0 (foldr (\pid d -> text (getShortID allIDs pid) $$ d) empty l) renderPatchState = text . prettyPatchState renderPatchNameShort p = (text (prettyDate (p_date p)) <+> text (p_author p) $$ text " *" <+> text (unPatchGroupID (p_name p))) renderPatchName p = renderPatchNameShort p $$ (text ("(Hash: " ++ unPatchID (p_id p) ++ ")")) prettyPatchState s = case s of PatchStateUNDECIDED -> "UNDECIDED" PatchStateAPPLIED -> "APPLIED" (PatchStateDISCARDED r) -> prettyReason r prettyReason r = case r of ReasonRejected -> "REJECTED" ReasonObsolete -> "OBSOLETE" renderDate = text . prettyDate renderLog [] = text "History: -" renderLog l = text "History: " $$ nest 0 (foldr (\entry d -> renderLogEntry entry $$ d) empty l) -- FIXME: this is not the right place to filter out log message isIrrelevantLogEntry :: LogEntry -> Bool isIrrelevantLogEntry entry = not (log_modelChanged entry) && log_message entry == "added" renderLogEntry entry = if isIrrelevantLogEntry entry then empty else text "*" <+> nest 2 (renderDate (log_time entry) <+> text (log_user entry) $$ (text (log_message entry))) renderDarcsLog :: [String] -> Doc renderDarcsLog list = text "Long comment:" $$ nest 1 (vcat $ map text list) colored :: Config -> Colors.Color -> Doc -> Doc colored cfg c doc | cfg_colored cfg = text (Colors.colored c) <> doc <> text (Colors.colored Colors.Reset) | otherwise = doc colored1, colored2 :: Config -> Doc -> Doc colored1 cfg = colored cfg (cfg_color1 cfg) colored2 cfg = colored cfg (cfg_color2 cfg)