clckwrks-plugin-bugs 0.5.1 → 0.6.0
raw patch · 10 files changed
+83/−64 lines, 10 filesdep ~acid-statedep ~clckwrksdep ~clckwrks-plugin-pagesetup-changed
Dependency ranges changed: acid-state, clckwrks, clckwrks-plugin-page, happstack-hsp, happstack-server, hsp, reform, reform-happstack, reform-hsp
Files
- Clckwrks/Bugs/Monad.hs +7/−5
- Clckwrks/Bugs/Page/EditBug.hs +18/−15
- Clckwrks/Bugs/Page/EditMilestones.hs +14/−8
- Clckwrks/Bugs/Page/SubmitBug.hs +10/−8
- Clckwrks/Bugs/Page/Template.hs +3/−2
- Clckwrks/Bugs/Page/Timeline.hs +7/−4
- Clckwrks/Bugs/Page/ViewBug.hs +5/−3
- Clckwrks/Bugs/PreProcess.hs +6/−6
- Setup.hs +2/−2
- clckwrks-plugin-bugs.cabal +11/−11
Clckwrks/Bugs/Monad.hs view
@@ -15,9 +15,11 @@ import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Happstack.Server import Happstack.Server.Internal.Monads (FilterFun)-import HSP (Attr((:=)), Attribute(MkAttr), EmbedAsAttr(..), EmbedAsChild(..), IsName(toName), XMLGenT, XML, pAttrVal)+import HSP.XMLGenerator (Attr((:=)), EmbedAsAttr(..), EmbedAsChild(..), IsName(toName), XMLGenT)+import HSP.XML (Attribute(MkAttr), XML, pAttrVal) import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>)) import Text.Reform (CommonFormError, FormError(..))@@ -45,15 +47,15 @@ type BugsForm = ClckFormT BugsFormError BugsM -instance (IsName n) => EmbedAsAttr BugsM (Attr n BugsURL) where+instance (IsName n TL.Text) => EmbedAsAttr BugsM (Attr n BugsURL) where asAttr (n := u) = do url <- showURL u- asAttr $ MkAttr (toName n, pAttrVal (T.unpack url))+ asAttr $ MkAttr (toName n, pAttrVal (TL.fromStrict url)) -instance (IsName n) => EmbedAsAttr BugsM (Attr n ClckURL) where+instance (IsName n TL.Text) => EmbedAsAttr BugsM (Attr n ClckURL) where asAttr (n := url) = do showFn <- bugsClckURL <$> ask- asAttr $ MkAttr (toName n, pAttrVal (T.unpack $ showFn url []))+ asAttr $ MkAttr (toName n, pAttrVal (TL.fromStrict $ showFn url [])) instance (Functor m, Monad m, EmbedAsChild m String) => EmbedAsChild m BugId where asChild (BugId i) = asChild $ '#' : show i
Clckwrks/Bugs/Page/EditBug.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.Page.EditBug where import Control.Arrow (first)@@ -16,9 +16,12 @@ import Data.Maybe (fromJust) import Data.String (fromString) import Data.Time (UTCTime, getCurrentTime)-import Data.Text (Text, pack)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Set as Set-import HSP+import HSP.XML+import HSP.XMLGenerator import Text.Reform ( CommonFormError(..), Form, FormError(..), Proof(..), (++>) , (<++), prove, transformEither, transform, view )@@ -41,7 +44,7 @@ template (fromString "Edit Bug Report") () <%> <h1>Edit Bug Report</h1>- <% reform (form here) "sbr" updateReport Nothing (editBugForm users milestones bug) %>+ <% reform (form here) (TL.pack "sbr") updateReport Nothing (editBugForm users milestones bug) %> </%> where updateReport :: Bug -> BugsM Response@@ -51,7 +54,7 @@ getUsers :: BugsM [(Maybe UserId, Text)] getUsers =- ((Nothing, pack "Unassigned") :) . map (first Just) <$> query GetUserIdUsernames+ ((Nothing, T.pack "Unassigned") :) . map (first Just) <$> query GetUserIdUsernames editBugForm :: [(Maybe UserId, Text)] -> [Milestone] -> Bug -> BugsForm Bug@@ -66,37 +69,37 @@ <*> bugBodyForm bugBody <*> pure Set.empty <*> bugMilestoneForm bugMilestone- <* (divFormActions $ inputSubmit' (pack "update")))+ <* (divFormActions $ inputSubmit' (T.pack "update"))) where divFormActions = mapView (\xml -> [<div class="form-actions"><% xml %></div>]) divHorizontal = mapView (\xml -> [<div class="form-horizontal"><% xml %></div>]) divControlGroup = mapView (\xml -> [<div class="control-group"><% xml %></div>]) divControls = mapView (\xml -> [<div class="controls"><% xml %></div>])- inputSubmit' str = inputSubmit str `setAttrs` [("class":="btn")]- label' str = (label str `setAttrs` [("class":="control-label")])+ inputSubmit' str = inputSubmit str `setAttrs` [("class":="btn") :: Attr TL.Text TL.Text]+ label' str = (label str `setAttrs` [("class":="control-label") :: Attr TL.Text TL.Text]) bugStatusForm :: BugStatus -> BugsForm BugStatus bugStatusForm oldStatus =- divControlGroup $ label' (pack "Status:") ++> (divControls $ select [(s, show s) | s <- [minBound .. maxBound]] (== oldStatus))+ divControlGroup $ label' (T.pack "Status:") ++> (divControls $ select [(s, show s) | s <- [minBound .. maxBound]] (== oldStatus)) bugAssignedForm :: Maybe UserId -> BugsForm (Maybe UserId) bugAssignedForm mUid =- divControlGroup $ label' (pack "Assigned:") ++>+ divControlGroup $ label' (T.pack "Assigned:") ++> (divControls $ select users (== mUid)) bugTitleForm :: Text -> BugsForm Text bugTitleForm oldTitle =- divControlGroup $ label' (pack "Summary:") ++> (divControls $ inputText oldTitle `setAttrs` ["size" := "80", "class" := "input-xxlarge"])+ divControlGroup $ label' (T.pack "Summary:") ++> (divControls $ inputText oldTitle `setAttrs` ["size" := "80", "class" := "input-xxlarge" :: Attr TL.Text TL.Text]) bugBodyForm :: Markup -> BugsForm Markup bugBodyForm oldBody =- divControlGroup $ label' (pack "Details:") ++> (divControls $ ((\t -> Markup [HsColour, Markdown] t Untrusted) <$> (textarea 80 20 (markup oldBody) `setAttrs` [("class" := "input-xxlarge")])))+ divControlGroup $ label' (T.pack "Details:") ++> (divControls $ ((\t -> Markup [HsColour, Markdown] t Untrusted) <$> (textarea 80 20 (markup oldBody) `setAttrs` [("class" := "input-xxlarge") :: Attr TL.Text TL.Text]))) bugMilestoneForm :: Maybe MilestoneId -> BugsForm (Maybe MilestoneId) bugMilestoneForm mMilestone =- divControlGroup $ label' (pack "Milestone:") ++>- (divControls $ select ((Nothing, pack "none") : [(Just $ milestoneId m, milestoneTitle m) | m <- milestones]) (== mMilestone))+ divControlGroup $ label' (T.pack "Milestone:") ++>+ (divControls $ select ((Nothing, T.pack "none") : [(Just $ milestoneId m, milestoneTitle m) | m <- milestones]) (== mMilestone)) impure :: (Monoid view, Monad m) => m a -> Form m input error view () a
Clckwrks/Bugs/Page/EditMilestones.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.Page.EditMilestones where import Control.Arrow (first)@@ -16,9 +16,11 @@ import Data.Monoid (mempty) import Data.Maybe (fromJust, isJust) import Data.Time (UTCTime, getCurrentTime)-import Data.Text (Text, pack) import qualified Data.Set as Set-import HSP+import Data.Text (Text, pack)+import qualified Data.Text.Lazy as TL+import HSP.XML+import HSP.XMLGenerator import Text.Reform ( CommonFormError(..), Form, FormError(..), Proof(..), (++>) , (<++), prove, transformEither, transform, view )@@ -31,7 +33,7 @@ do milestones <- query GetMilestones template (fromString "Edit Milestones") () <%>- <% reform (form here) "em" updateMilestones Nothing (editMilestonesForm milestones) %>+ <% reform (form here) (TL.pack "em") updateMilestones Nothing (editMilestonesForm milestones) %> </%> where updateMilestones :: ([Milestone], (Bool, Bool)) -> BugsM Response@@ -51,15 +53,19 @@ editMilestonesForm :: [Milestone] -> BugsForm ([Milestone], (Bool, Bool)) editMilestonesForm milestones = (divHorizontal $ fieldset $- (,) <$> (sequenceA $ map editMilestoneForm milestones) <*> (divFormActions $ (,) <$> (isJust <$> inputSubmit' (pack "update")) <*> (isJust <$> inputSubmit' (pack "add new milestone")))+ (,) <$> (sequenceA $ map editMilestoneForm milestones)+ <*> ( divFormActions $ (,)+ <$> (isJust <$> inputSubmit' (pack "update"))+ <*> (isJust <$> inputSubmit' (pack "add new milestone"))+ ) ) where divFormActions = mapView (\xml -> [<div class="form-actions"><% xml %></div>]) divHorizontal = mapView (\xml -> [<div class="form-horizontal"><% xml %></div>]) divControlGroup = mapView (\xml -> [<div class="control-group"><% xml %></div>]) divControls = mapView (\xml -> [<div class="controls"><% xml %></div>])- label' str = (label str `setAttrs` [("class":="control-label")])- inputSubmit' str = inputSubmit str `setAttrs` [("class":="btn")]+ label' str = (label str `setAttrs` [("class":="control-label") :: Attr TL.Text TL.Text])+ inputSubmit' str = inputSubmit str `setAttrs` [("class":="btn") :: Attr TL.Text TL.Text] editMilestoneForm ms@Milestone{..} = divControlGroup $
Clckwrks/Bugs/Page/SubmitBug.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.Page.SubmitBug where import Control.Monad.Reader (ask)@@ -15,8 +15,10 @@ import Data.Maybe (fromJust) import Data.Time (UTCTime, getCurrentTime) import Data.Text (Text, pack)+import qualified Data.Text.Lazy as TL import qualified Data.Set as Set-import HSP+import HSP.XML+import HSP.XMLGenerator import Text.Reform ( CommonFormError(..), Form, FormError(..), Proof(..), (++>) , (<++), prove, transformEither, transform, view) import Text.Reform.Happstack@@ -29,7 +31,7 @@ do template (fromString "Submit a Report") () <%> <h1>Submit Bug Report</h1>- <% reform (form here) "sbr" addReport Nothing submitForm %>+ <% reform (form here) (TL.pack "sbr") addReport Nothing submitForm %> </%> where addReport :: Bug -> BugsM Response@@ -57,8 +59,8 @@ divHorizontal = mapView (\xml -> [<div class="form-horizontal"><% xml %></div>]) divControlGroup = mapView (\xml -> [<div class="control-group"><% xml %></div>]) divControls = mapView (\xml -> [<div class="controls"><% xml %></div>])- inputSubmit' str = inputSubmit str `setAttrs` [("class":="btn")]- label' str = (label str `setAttrs` [("class":="control-label")])+ inputSubmit' str = inputSubmit str `setAttrs` [("class":="btn") :: Attr TL.Text TL.Text]+ label' str = (label str `setAttrs` [("class":="control-label") :: Attr TL.Text TL.Text]) submittorIdForm :: BugsForm UserId submittorIdForm = impure (fromJust <$> getUserId)@@ -68,11 +70,11 @@ bugTitleForm :: BugsForm Text bugTitleForm =- divControlGroup (label' (pack "Summary:") ++> (divControls $ inputText mempty `setAttrs` ["size" := "80", "class" := "input-xxlarge"]))+ divControlGroup (label' (pack "Summary:") ++> (divControls $ inputText mempty `setAttrs` ["size" := "80", "class" := "input-xxlarge" :: Attr TL.Text TL.Text])) bugBodyForm :: BugsForm Markup bugBodyForm =- divControlGroup (label' (pack "Details:") ++> (divControls $ (\t -> Markup [HsColour, Markdown] t Untrusted) <$> (textarea 80 20 mempty `setAttrs` [("class" := "input-xxlarge")])))+ divControlGroup (label' (pack "Details:") ++> (divControls $ (\t -> Markup [HsColour, Markdown] t Untrusted) <$> (textarea 80 20 mempty `setAttrs` [("class" := "input-xxlarge"):: Attr TL.Text TL.Text]))) impure :: (Monoid view, Monad m) => m a -> Form m input error view () a
Clckwrks/Bugs/Page/Template.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts, OverloadedStrings #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.Page.Template where import Clckwrks@@ -9,7 +9,8 @@ import Control.Monad.Reader import Control.Monad.State import Data.Text (Text)-import HSP hiding (escape)+import HSP.XML+import HSP.XMLGenerator import Happstack.Server.HSP.HTML () import Web.Plugins.Core (Plugin(..), getPluginRouteFn, getTheme)
Clckwrks/Bugs/Page/Timeline.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.Page.Timeline where import Clckwrks@@ -11,7 +11,10 @@ import qualified Data.IxSet as IxSet import Data.List (find) import Data.String (fromString)+import qualified Data.Text.Lazy as Text import Numeric (showFFloat)+import HSP.XML+import HSP.XMLGenerator timeline :: BugsM Response timeline =@@ -37,7 +40,7 @@ do completed <- query (MilestoneCompletion mid) <%> <h2><% milestoneTitle m %></h2>- <% maybe (return $ cdata "") meter completed %>+ <% maybe (return $ cdata $ fromStringLit "") meter completed %> <table> <thead> <tr>@@ -53,7 +56,7 @@ showBugSummary :: Bug -> XMLGenT BugsM XML showBugSummary Bug{..} =- <tr ["class" := (if (bugStatus == New) || (bugStatus == Accepted) then "bug-summary-open" else "bug-summary-closed")] >+ <tr [Text.pack "class" := (if (bugStatus == New) || (bugStatus == Accepted) then (Text.pack "bug-summary-open") else (Text.pack "bug-summary-closed"))] > <td><a href=(ViewBug bugId)><% bugId %></a></td> <td><% bugTitle %></td> </tr>@@ -63,5 +66,5 @@ -> XMLGenT BugsM XML meter completed = <div class="meter">- <span style=("width: " ++ (showFFloat (Just 3) ((fromRational (toRational completed)) * 100) "%"))></span>+ <span style=(Text.pack $ "width: " ++ (showFFloat (Just 3) ((fromRational (toRational completed)) * 100) "%"))></span> </div>
Clckwrks/Bugs/Page/ViewBug.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts, RecordWildCards #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.Page.ViewBug where import Clckwrks@@ -15,6 +15,8 @@ import qualified Data.Set as Set import Data.String (fromString) import Data.Text (pack)+import HSP.XML+import HSP.XMLGenerator import Happstack.Auth (AuthState, ProfileState) import Control.Monad.State@@ -65,5 +67,5 @@ do b <- query (HasRole uid role) if b then xml- else return $ cdata ""- _ -> return $ cdata ""+ else return $ cdata $ fromStringLit ""+ _ -> return $ cdata $ fromStringLit ""
Clckwrks/Bugs/PreProcess.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Bugs.PreProcess where import Control.Monad.Trans@@ -10,15 +10,15 @@ import Clckwrks.Bugs.Types (BugId(..)) import Clckwrks.Monad (transform, segments) import Data.Attoparsec.Text.Lazy (Parser, Result(..), char, choice, decimal, parse, skipMany, space, asciiCI, skipMany)-import Data.Monoid (mempty)+import Data.Monoid (mconcat, mempty) import Data.Text (Text, pack) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as B-import HSP-import HSP.HTML (renderAsHTML)-import HSP.Identity (evalIdentity)+import HSP.HTML4 (renderAsHTML)+import HSP.XML+import HSP.XMLGenerator import Web.Routes (showURL) data BugsCmd@@ -63,7 +63,7 @@ applyCmd bugsShowURL (ShowBug bid) = do html <- unXMLGenT $ <a href=(bugsShowURL (ViewBug bid) [])>#<% show $ unBugId bid %></a>- return $ B.fromString $ concat $ lines $ renderAsHTML html+ return $ mconcat $ map B.fromLazyText $ TL.lines $ renderAsHTML html {- applyCmd bugsShowURL ShowTimeline = do html <- unXMLGenT $ timelineWidget
Setup.hs view
@@ -5,9 +5,9 @@ import Distribution.Simple import Distribution.Simple.Program -trhsxProgram = simpleProgram "trhsx"+hsx2hsProgram = simpleProgram "hsx2hs" main :: IO () main = defaultMainWithHooks simpleUserHooks {- hookedPrograms = [trhsxProgram]+ hookedPrograms = [hsx2hsProgram] }
clckwrks-plugin-bugs.cabal view
@@ -1,5 +1,5 @@ Name: clckwrks-plugin-bugs-Version: 0.5.1+Version: 0.6.0 Synopsis: bug tracking plugin for clckwrks Homepage: http://clckwrks.com/ License: BSD3@@ -20,7 +20,7 @@ Library Build-tools:- trhsx+ hsx2hs Exposed-modules: Clckwrks.Bugs@@ -41,23 +41,23 @@ Build-depends: base < 5,- acid-state >= 0.7,+ acid-state >= 0.9, attoparsec == 0.10.*,- clckwrks >= 0.16 && < 0.17,- clckwrks-plugin-page == 0.1.*,+ clckwrks >= 0.18 && < 0.19,+ clckwrks-plugin-page == 0.2.*, containers >= 0.4 && < 0.6, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.4, happstack-authenticate == 0.10.*,- happstack-server >= 7.0 && < 7.2,- happstack-hsp == 7.1.*,- hsp == 0.7.*,+ happstack-server >= 7.0 && < 7.4,+ happstack-hsp == 7.2.*,+ hsp == 0.9.*, ixset == 1.0.*, mtl >= 2.0 && < 2.3, network >= 2.3 && < 2.5,- reform == 0.1.*,- reform-happstack == 0.1.*,- reform-hsp >= 0.1.1 && < 0.2,+ reform == 0.2.*,+ reform-happstack == 0.2.*,+ reform-hsp >= 0.2 && < 0.3, safecopy >= 0.6, time == 1.4.*, text == 0.11.*,