diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs index e79577f..4478623 100644 --- a/src/Vervis/Widget/Ticket.hs +++ b/src/Vervis/Widget/Ticket.hs @@ -17,21 +17,27 @@ module Vervis.Widget.Ticket ( TicketSummary (..) , ticketDepW , ticketSummaryW + , ticketTreeVW + , ticketTreeDW ) where import Prelude -import Control.Arrow ((***)) +import Control.Arrow ((&&&), (***)) import Data.HashMap.Lazy (HashMap) +import Data.Maybe (mapMaybe) import Data.Text (Text) import Data.Time.Clock (UTCTime) -import Yesod.Core.Handler (getCurrentRoute) -import Yesod.Core (newIdent) +import Yesod.Core (MonadHandler, newIdent) +import Yesod.Core.Handler (getCurrentRoute, getRequest, YesodRequest (..)) +import Yesod.Core.Widget (whamlet) import qualified Data.HashMap.Lazy as M (toList) -import qualified Data.Text as T (pack, unpack) +import qualified Data.Text as T (null, pack, unpack) +import qualified Data.Text.Read as TR (decimal) +import Data.Graph.DirectedAcyclic.View.Tree import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident @@ -68,3 +74,54 @@ ticketSummaryW shr prj ts mcs = do mparams = map (tshow *** tshow) . M.toList <$> mcs mroute <- getCurrentRoute $(widgetFile "ticket/widget/summary") + +-- I'm noticing a pattern. A problem. Some of my widget functions take data and +-- directly represent it in HTML. Others take some other more general +-- structures, then pick the relevant pieces and generate HTML. Others involve +-- IO actions, especially DB access. +-- +-- So here's an idea to try. Instead of the W suffix, have 3 suffixes: +-- +-- * /VW/ - view widget, direct data to HTML conversion +-- * /DW/ - data widget, takes more general data and picks some for the view +-- * /PW/ - persistent widget, takes data from filesystem or DB +ticketTreeVW + :: ShrIdent + -> PrjIdent + -> Text + -> DagViewTree TicketSummary (TicketSummary, HashMap Int Int) + -> Widget +ticketTreeVW shr prj cDeps t = go t + where + summary = ticketSummaryW shr prj + go (FullNode ts trees) = do + summary ts Nothing + [whamlet| +
+ $forall tree <- trees + ^{go tree} + |] + go (LinkNode (ts, cs)) = summary ts (Just cs) + +-- | In the request's GET parameters, find ones of the form @N=M@ where N and M +-- are integers. Return a list of pairs corresponding to those parameters. +getParentChoices :: MonadHandler m => m [(Int, Int)] +getParentChoices = mapMaybe readInts . reqGetParams <$> getRequest + where + readInts (ct, pt) = + case (TR.decimal ct, TR.decimal pt) of + (Right (c, cr), Right (p, pr)) -> + if T.null cr && T.null pr + then Just (c, p) + else Nothing + _ -> Nothing + +ticketTreeDW + :: ShrIdent -> PrjIdent -> [TicketSummary] -> [(Int, Int)] -> Widget +ticketTreeDW shr prj summaries deps = do + cDeps <- newIdent + choices <- getParentChoices + let nodes = map (tsNumber &&& id) summaries + oneTree = ticketTreeVW shr prj cDeps + forest = map oneTree $ dagViewTree nodes deps choices + $(widgetFile "ticket/widget/tree") diff --git a/templates/ticket/widget/tree.cassius b/templates/ticket/widget/tree.cassius new file mode 100644 index 0000000..7750f14 --- /dev/null +++ b/templates/ticket/widget/tree.cassius @@ -0,0 +1,17 @@ +/* This file is part of Vervis. + * + * Written in 2016 by fr33domlover . + * + * ♡ Copying is an act of love. Please copy, reuse and share. + * + * The author(s) have dedicated all copyright and related and neighboring + * rights to this software to the public domain worldwide. This software is + * distributed without any warranty. + * + * You should have received a copy of the CC0 Public Domain Dedication along + * with this software. If not, see + * . + */ + +.#{cDeps} + margin-left: 2em diff --git a/templates/ticket/widget/tree.hamlet b/templates/ticket/widget/tree.hamlet new file mode 100644 index 0000000..5312c50 --- /dev/null +++ b/templates/ticket/widget/tree.hamlet @@ -0,0 +1,17 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ Copying is an act of love. Please copy, reuse and share. +$# +$# The author(s) have dedicated all copyright and related and neighboring +$# rights to this software to the public domain worldwide. This software is +$# distributed without any warranty. +$# +$# You should have received a copy of the CC0 Public Domain Dedication along +$# with this software. If not, see +$# . + +
+ $forall tree <- forest + ^{tree}