{-# LANGUAGE DeriveGeneric #-}
module Pending ( findPending ) where
import Ast
import Data.Tree
import Text.PrettyPrint
type PendingTree = Tree String
data FormatTree
= TEmpty FormatTree
| TSpace FormatTree
| TBranch FormatTree
| TNode
| TLeaf
showTree :: FormatTree -> Doc
showTree (TEmpty t) = showTree t
showTree (TBranch t) = text " | " <> showTree t
showTree (TSpace t) = text " " <> showTree t
showTree TNode = text " |- "
showTree TLeaf = text " |> "
linebreak :: Doc
linebreak = text "\n"
formatTree :: PendingTree -> Doc
formatTree t = formatSubTree (TEmpty) t
formatSubTrees :: (FormatTree -> FormatTree) -> [PendingTree] -> Doc
formatSubTrees _ [] = empty
formatSubTrees ft [(Node s [])] =
showTree (ft TLeaf) <> text s
formatSubTrees ft [t] =
showTree (ft TNode) <> formatSubTree (ft . TSpace) t
formatSubTrees ft ((Node s []):ts) =
showTree (ft TLeaf) <> text s <> linebreak <>
(formatSubTrees ft ts)
formatSubTrees ft (t:ts) =
showTree (ft TNode) <> formatSubTree (ft . TBranch) t <> linebreak <>
(formatSubTrees ft ts)
formatSubTree :: (FormatTree -> FormatTree) -> PendingTree -> Doc
formatSubTree _ (Node s []) =
text s
formatSubTree tree (Node s ts) =
text s <> linebreak <> formatSubTrees tree ts
size :: PendingTree -> Int
size (Node _ []) = 1
size (Node _ (t @ (_:_))) = sum $ map size t
limitPendingTree :: Int -> PendingTree -> PendingTree
limitPendingTree _ (Node t []) = (Node t [])
limitPendingTree 0 (Node t sub) = (Node (t ++ showTasks (sum $ map size sub)) [])
limitPendingTree n (Node t sub) = (Node t (map (limitPendingTree (n-1)) sub))
showTasks :: Int -> String
showTasks 1 = " (1 task)"
showTasks n = " (" ++ (show n) ++ " tasks)"
pendingJudgement :: Judgement -> [PendingTree]
pendingJudgement (Bonus (_, _)) = []
pendingJudgement (Judgement (Header (t, p, _), _, _, [])) | isInfinite p = [Node t []]
pendingJudgement (Judgement (Header (_, _, _), _, _, [])) = []
pendingJudgement (Judgement (Header (t, _, _), _, _, subJs @ (_:_))) =
case (concatMap pendingJudgement subJs) of
[] -> []
sub -> [Node t sub]
findPending :: Maybe Int -> [Judgement] -> Maybe(String)
findPending detailLevel js =
case (concatMap pendingJudgement js) of
[] -> Nothing
t ->
case detailLevel of
Nothing -> Just $ render $ vcat $ map formatTree t
(Just i) -> Just $ render $ vcat $ map (formatTree . (limitPendingTree i)) t