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}