packages feed

clckwrks-plugin-bugs (empty) → 0.3.0

raw patch · 18 files changed

+1311/−0 lines, 18 filesdep +acid-statedep +attoparsecdep +basebuild-type:Customsetup-changed

Dependencies added: acid-state, attoparsec, base, blaze-html, clckwrks, containers, directory, filepath, gd, happstack-authenticate, happstack-hsp, happstack-server, hsp, ixset, magic, mtl, network, reform, reform-happstack, reform-hsp, safecopy, text, time, web-plugins, web-routes, web-routes-th

Files

+ Clckwrks/Bugs.hs view
@@ -0,0 +1,11 @@+module Clckwrks.Bugs+   ( module Clckwrks.Bugs.URL+   , module Clckwrks.Bugs.Monad+   , module Clckwrks.Bugs.Route+   , module Clckwrks.Bugs.Types+   ) where++import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Route+import Clckwrks.Bugs.Types
+ Clckwrks/Bugs/Acid.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, TypeFamilies #-}+module Clckwrks.Bugs.Acid where++import Control.Applicative    ((<$>))+import Control.Monad.Reader   (ask)+import Control.Monad.State    (get, modify, put)+import Data.Acid              (Query, Update, makeAcidic)+import Data.IxSet             (IxSet, Proxy(..), (@=), (@+), getOne, empty, toAscList, toList, fromList, updateIx)+import qualified Data.IxSet   as IxSet+import Data.Map               (Map)+import qualified Data.Map     as Map+import Data.Ratio             ((%))+import Data.SafeCopy          (base, deriveSafeCopy, extension, Migrate(..))+import           Data.Text    (Text)+import qualified Data.Text    as Text+import Clckwrks.Bugs.Types    (Bug(..), BugStatus(..), BugId(..), Milestone(..), MilestoneId(..), TargetDate(..))++data BugsState_0 = BugsState_0+    { nextBugId_0       :: BugId+    , bugs_0            :: IxSet Bug+    }+$(deriveSafeCopy 0 'base ''BugsState_0)++-- | 'BugsState' stores all the bugs+data BugsState = BugsState+    { nextBugId       :: BugId+    , bugs            :: IxSet Bug+    , nextMilestoneId :: MilestoneId+    , milestones      :: IxSet Milestone+    }+$(deriveSafeCopy 1 'extension ''BugsState)++instance Migrate BugsState where+    type MigrateFrom BugsState = BugsState_0+    migrate (BugsState_0 n b) = BugsState n b (MilestoneId 1) empty++-- | initial 'BugsState'+initialBugsState :: BugsState+initialBugsState = BugsState+    { nextBugId       = BugId 1+    , bugs            = empty+    , nextMilestoneId = MilestoneId 1+    , milestones      = empty+    }++-- | get the next unused 'BugsId'+genBugId :: Update BugsState BugId+genBugId =+    do bs@BugsState{..} <- get+       put $ bs { nextBugId = BugId $ succ $ unBugId $ nextBugId }+       return nextBugId++-- | get 'Bugs' by 'BugId'+getBugById :: BugId -> Query BugsState (Maybe Bug)+getBugById bid =+    do BugsState{..} <- ask+       return $ getOne (bugs @= bid)++-- | store 'Bugs' in the state. Will overwrite an existing entry with the same 'BugId'+putBug :: Bug -> Update BugsState ()+putBug bug =+    do bs@BugsState{..} <- get+       put $ bs { bugs = updateIx (bugId bug) bug bugs }++allBugIds :: Query BugsState [BugId]+allBugIds =+    do BugsState{..} <- ask+       return $ map bugId (toList bugs)++------------------------------------------------------------------------------+-- Milestones+------------------------------------------------------------------------------++-- | add a new, empty 'Milestone' to the database and return the 'MilestoneId'+newMilestone :: Update BugsState MilestoneId+newMilestone =+    do bs@BugsState{..} <- get+       let milestone = Milestone { milestoneId      = nextMilestoneId+                                 , milestoneTitle   = Text.empty+                                 , milestoneTarget  = Nothing+                                 , milestoneReached = Nothing+                                 }+       put $ bs { nextMilestoneId = succ nextMilestoneId+                , milestones      = IxSet.insert milestone milestones+                }+       return nextMilestoneId++-- | get the milestones+getMilestones :: Query BugsState [Milestone]+getMilestones =+    do ms <- milestones <$> ask+       return (toList ms)++-- | get all the 'MilestoneId's+getMilestoneIds :: Query BugsState [MilestoneId]+getMilestoneIds =+    do ms <- milestones <$> ask+       return (map milestoneId $ toList ms)++-- | get the 'milestoneTitle' for a 'MilestoneId'+getMilestoneTitle :: MilestoneId -> Query BugsState (Maybe Text)+getMilestoneTitle mid =+    do ms <- milestones <$> ask+       return $ milestoneTitle <$> getOne (ms @= mid)++-- | get the milestones sorted by target date+setMilestones :: [Milestone] -> Update BugsState ()+setMilestones ms =+    modify $ \bs -> bs { milestones = fromList ms }++-- | get all the 'Bug's with one of the target 'MilestoneId's+bugsForMilestones :: [MilestoneId] -> Query BugsState (IxSet Bug)+bugsForMilestones mids =+    do bs <- bugs <$> ask+       return $ (bs @+ mids)++-- | return the percentage completion of a 'MilestoneId'+--+-- Will return 'Nothing' if no bugs were found for the 'MilestoneId'+milestoneCompletion :: MilestoneId+                    -> Query BugsState (Maybe Rational)+milestoneCompletion mid =+    do bs <- IxSet.getEQ mid . bugs <$> ask+       case IxSet.size bs of+         0     -> return Nothing+         total -> let closed = IxSet.size (bs @+ [Closed, Invalid, WontFix])+                  in return $ Just (toRational (closed % total))++$(makeAcidic ''BugsState+   [ 'genBugId+   , 'getBugById+   , 'putBug+   , 'allBugIds+   , 'newMilestone+   , 'getMilestones+   , 'getMilestoneTitle+   , 'setMilestones+   , 'bugsForMilestones+   , 'milestoneCompletion+   ]+ )
+ Clckwrks/Bugs/Monad.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeFamilies, TypeSynonymInstances, UndecidableInstances, OverloadedStrings #-}+module Clckwrks.Bugs.Monad where++import Clckwrks                 (Clck, ClckT(..), ClckFormT, ClckState(..), ClckURL(..), mapClckT)+import Clckwrks.Acid+import Clckwrks.IOThread        (IOThread(..), startIOThread, killIOThread)+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.Types+import Clckwrks.Bugs.URL+import Control.Applicative ((<$>))+import Control.Exception   (bracket)+import Control.Monad.Reader (ReaderT(..), MonadReader(..))+import Data.Acid           (AcidState)+import Data.Acid.Local     (createCheckpointAndClose, openLocalStateFrom)+import qualified Data.Map  as Map+import Data.Maybe          (fromMaybe)+import qualified Data.Text as T+import Happstack.Server+import Happstack.Server.Internal.Monads (FilterFun)+import HSP                  (Attr((:=)), Attribute(MkAttr), EmbedAsAttr(..), EmbedAsChild(..), IsName(toName), XMLGenT, XML, pAttrVal)+import System.Directory     (createDirectoryIfMissing)+import System.FilePath      ((</>))+import Text.Reform          (CommonFormError, FormError(..))+import Web.Routes           (URL, MonadRoute, showURL)++data BugsConfig = BugsConfig+    { bugsDirectory    :: FilePath -- ^ directory in which to store uploaded attachments+    , bugsState        :: AcidState BugsState+    , bugsClckURL      :: ClckURL -> [(T.Text, Maybe T.Text)] -> T.Text+    }++type BugsT m = ClckT BugsURL (ReaderT BugsConfig m)+type BugsM   = ClckT BugsURL (ReaderT BugsConfig (ServerPartT IO))++data BugsFormError+    = BugsCFE (CommonFormError [Input])+      deriving Show++instance FormError BugsFormError where+    type ErrorInputType BugsFormError = [Input]+    commonFormError = BugsCFE++instance (Functor m, Monad m) => EmbedAsChild (BugsT m) BugsFormError where+    asChild e = asChild (show e)++type BugsForm = ClckFormT BugsFormError BugsM++instance (IsName n) => EmbedAsAttr BugsM (Attr n BugsURL) where+        asAttr (n := u) =+            do url <- showURL u+               asAttr $ MkAttr (toName n, pAttrVal (T.unpack url))++instance (IsName n) => EmbedAsAttr BugsM (Attr n ClckURL) where+        asAttr (n := url) =+            do showFn <- bugsClckURL <$> ask+               asAttr $ MkAttr (toName n, pAttrVal (T.unpack $ showFn url []))++instance (Functor m, Monad m, EmbedAsChild m String) => EmbedAsChild m BugId where+    asChild (BugId i) = asChild $ '#' : show i++runBugsT :: BugsConfig -> BugsT m a -> ClckT BugsURL m a+runBugsT mc m = mapClckT f m+    where+      f r = runReaderT r mc++instance (Monad m) => MonadReader BugsConfig (BugsT m) where+    ask = ClckT $ ask+    local f (ClckT m) = ClckT $ local f m++instance (Functor m, Monad m) => GetAcidState (BugsT m) BugsState where+    getAcidState =+        bugsState <$> ask+{-+withBugsConfig :: Maybe FilePath+               -> FilePath+               -> (BugsConfig -> IO a) -> IO a+withBugsConfig mBasePath bugsDir f =+    do let basePath = fromMaybe "_state" mBasePath+       bracket (openLocalStateFrom (basePath </> "bugs") initialBugsState) (createCheckpointAndClose) $ \bugsState ->+           f (BugsConfig { bugsDirectory    = bugsDir+                         , bugsState        = bugsState+                         , bugsClckURL      = undefined+--                         , bugsPageTemplate = undefined+                         })+-}
+ Clckwrks/Bugs/Page/EditBug.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.Page.EditBug where++import Control.Arrow        (first)+import Control.Monad.Reader (ask)+import Clckwrks+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Types+import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Page.Template (template)+import Clckwrks.ProfileData.Acid (GetUserIdUsernames(..))+import Data.Monoid (mempty)+import Data.Maybe  (fromJust)+import Data.String (fromString)+import Data.Time (UTCTime, getCurrentTime)+import Data.Text (Text, pack)+import qualified Data.Set as Set+import HSP+import Text.Reform ( CommonFormError(..), Form, FormError(..), Proof(..), (++>)+                   , (<++), prove, transformEither, transform, view+                   )+import Text.Reform.Happstack+import Text.Reform.HSP.Text++import Text.Reform++editBug :: BugsURL -> BugId -> BugsM Response+editBug here bid =+    do mBug <- query (GetBugById bid)+       case mBug of+         Nothing ->+             do notFound ()+                template (fromString "Bug not found.") ()+                         <h1>BugId Not Found: <% bid %></h1>+         (Just bug) ->+          do users      <- getUsers+             milestones <- query $ GetMilestones+             template (fromString "Edit Bug Report") ()+              <%>+               <h1>Edit Bug Report</h1>+--               <% reform (form here) "sbr" updateReport Nothing (editBugForm users milestones bug) %>+              </%>+    where+      updateReport :: Bug -> BugsM Response+      updateReport bug =+          do update $ PutBug bug+             seeOtherURL (ViewBug bid)++      getUsers :: BugsM [(Maybe UserId, Text)]+      getUsers =+          ((Nothing, pack "Unassigned") :) . map (first Just) <$> query GetUserIdUsernames+++editBugForm :: [(Maybe UserId, Text)] -> [Milestone] -> Bug -> BugsForm Bug+editBugForm users milestones bug@Bug{..} =+  (fieldset $ ol $+    Bug <$> pure bugId+        <*> pure bugSubmittor+        <*> pure bugSubmitted+        <*> bugStatusForm bugStatus+        <*> bugAssignedForm bugAssigned+        <*> bugTitleForm bugTitle+        <*> bugBodyForm bugBody+        <*> pure Set.empty+        <*> bugMilestoneForm bugMilestone+        <*  (li $ inputSubmit (pack "update")))+   `setAttrs` ["class" := "bugs"]+    where++      bugStatusForm :: BugStatus -> BugsForm BugStatus+      bugStatusForm oldStatus =+          (li $ label (pack "Status:")) ++> select [(s, show s) | s <- [minBound .. maxBound]] (== oldStatus)++      bugAssignedForm :: Maybe UserId -> BugsForm (Maybe UserId)+      bugAssignedForm mUid =+          (li $ label (pack "Assigned:")) ++>+            select users (== mUid)++      bugTitleForm :: Text -> BugsForm Text+      bugTitleForm oldTitle =+          (li $ label (pack "Summary:")) ++> (inputText oldTitle `setAttrs` ["size" := "80"])++      bugBodyForm :: Markup -> BugsForm Markup+      bugBodyForm oldBody =+          (li $ label (pack "Details:")) ++> ((\t -> Markup [HsColour, Markdown] t Untrusted) <$> textarea 80 20 (markup oldBody))++      bugMilestoneForm :: Maybe MilestoneId -> BugsForm (Maybe MilestoneId)+      bugMilestoneForm mMilestone =+          (li $ label (pack "Milestone:")) ++>+            select ((Nothing, pack "none") : [(Just $ milestoneId m, milestoneTitle m) | m <- milestones]) (== mMilestone)+++impure :: (Monoid view, Monad m) => m a -> Form m input error view () a+impure ma =+      Form $+        do i <- getFormId+           return (View $ const $ mempty, do a <- ma+                                             return $ Ok $ Proved { proofs    = ()+                                                                  , pos       = FormRange i i+                                                                  , unProved  = a+                                                                  })
+ Clckwrks/Bugs/Page/EditMilestones.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.Page.EditMilestones where++import Control.Arrow        (first)+import Control.Monad.Reader (ask)+import Clckwrks+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Types+import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Page.Template (template)+import Clckwrks.ProfileData.Acid (GetUserIdUsernames(..))+import Data.String (fromString)+import Data.Traversable (sequenceA)+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 Text.Reform ( CommonFormError(..), Form, FormError(..), Proof(..), (++>)+                   , (<++), prove, transformEither, transform, view+                   )+import Text.Reform.Happstack+import Text.Reform.HSP.Text+import Text.Reform++editMilestones :: BugsURL -> BugsM Response+editMilestones here =+    do milestones <- query GetMilestones+       template (fromString "Edit Milestones") ()+         <%>+           <h1>Edit Milestones</h1>+--           <% reform (form here) "em" updateMilestones Nothing (editMilestonesForm milestones) %>+         </%>+    where+      updateMilestones :: ([Milestone], Bool, Bool) -> BugsM Response+      updateMilestones (_milestones, False, True) =+          do _mid <- update $ NewMilestone+             seeOtherURL here+      updateMilestones (milestones, True, False) =+          do update $ SetMilestones milestones+             seeOtherURL Timeline++-- |+--+-- FIXME: this can give odd results is the Milestone list changes+-- between the GET and POST requests. We need to use a different+-- pattern where the POST processing does not depend on the+-- [Milestone] parameter.+editMilestonesForm :: [Milestone] -> BugsForm ([Milestone], Bool, Bool)+editMilestonesForm milestones =+  (fieldset $ ol $+    (,,) <$> (sequenceA $ map editMilestoneForm milestones) <*> (isJust <$> inputSubmit (pack "update")) <*> (isJust <$> inputSubmit (pack "add new milestone"))+  ) `setAttrs` ["class" := "bugs"]+    where+      editMilestoneForm ms@Milestone{..} =+          li $ label ("#" ++ show (unMilestoneId milestoneId) ++" title:") ++>+                      ((\newTitle -> ms { milestoneTitle = newTitle }) <$> inputText milestoneTitle)++impure :: (Monoid view, Monad m) => m a -> Form m input error view () a+impure ma =+      Form $+        do i <- getFormId+           return (View $ const $ mempty, do a <- ma+                                             return $ Ok $ Proved { proofs    = ()+                                                                  , pos       = FormRange i i+                                                                  , unProved  = a+                                                                  })
+ Clckwrks/Bugs/Page/SubmitBug.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.Page.SubmitBug where++import Control.Monad.Reader (ask)+import Clckwrks+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Types+import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Page.Template (template)+import Data.String (fromString)+import Data.Monoid (mempty)+import Data.Maybe  (fromJust)+import Data.Time (UTCTime, getCurrentTime)+import Data.Text (Text, pack)+import qualified Data.Set as Set+import HSP+import Text.Reform ( CommonFormError(..), Form, FormError(..), Proof(..), (++>)+                   , (<++), prove, transformEither, transform, view)+import Text.Reform.Happstack+import Text.Reform.HSP.Text++import Text.Reform++submitBug :: BugsURL -> BugsM Response+submitBug here =+    do template (fromString "Submit a Report") ()+              <%>+               <h1>Submit Report</h1>+               <% reform (form here) "sbr" addReport Nothing submitForm %>+              </%>+    where+      addReport :: Bug -> BugsM Response+      addReport bug =+          do ident <- update GenBugId+             update $ PutBug (bug { bugId = ident })+             seeOtherURL (ViewBug ident)++submitForm :: BugsForm Bug+submitForm =+  (fieldset $ ol $+    Bug <$> pure (BugId 0)+        <*> submittorIdForm+        <*> nowForm+        <*> pure New+        <*> pure Nothing+        <*> bugTitleForm+        <*> bugBodyForm+        <*> pure Set.empty+        <*> pure Nothing+        <*  (li $ inputSubmit (pack "submit"))+  ) `setAttrs` ["class" := "bugs"]+     where+      submittorIdForm :: BugsForm UserId+      submittorIdForm = impure (fromJust <$> getUserId)++      nowForm :: BugsForm UTCTime+      nowForm = impure (liftIO getCurrentTime)++      bugTitleForm :: BugsForm Text+      bugTitleForm =+          (li $ label (pack "Summary:")) ++> (inputText mempty `setAttrs` ["size" := "80"])++      bugBodyForm :: BugsForm Markup+      bugBodyForm =+          (li $ label (pack "Details:")) ++> ((\t -> Markup [HsColour, Markdown] t Untrusted) <$> textarea 80 20 mempty)+++impure :: (Monoid view, Monad m) => m a -> Form m input error view () a+impure ma =+      Form $+        do i <- getFormId+           return (View $ const $ mempty, do a <- ma+                                             return $ Ok $ Proved { proofs    = ()+                                                                  , pos       = FormRange i i+                                                                  , unProved  = a+                                                                  })++
+ Clckwrks/Bugs/Page/Template.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.Page.Template where++import Clckwrks+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.URL+import Clckwrks.Plugin+import Control.Monad.Reader+import Control.Monad.State+import Data.Text (Text)+import HSP hiding (escape)+import Happstack.Server.HSP.HTML ()+import Web.Plugins.Core (Plugin(..), getPluginRouteFn, getTheme)++template :: ( EmbedAsChild BugsM headers+            , EmbedAsChild BugsM body+            ) =>+            Text+         -> headers+         -> body+         -> BugsM Response+template ttl hdrs bdy =+    do p <- plugins <$> get+       mTheme <- getTheme p+       (Just clckShowFn) <- getPluginRouteFn p (pluginName clckPlugin)+       case mTheme of+         Nothing      -> escape $ internalServerError $ toResponse $ ("No theme package is loaded." :: Text)+         (Just theme) ->+             do hdrXml <- fmap (map unClckChild) $ unXMLGenT $ asChild <%> <link rel="stylesheet" type="text/css" href=(BugsData "style.css") /> <% hdrs %></%>+                bdyXml <- fmap (map unClckChild) $ unXMLGenT $ asChild bdy+                fmap toResponse $ mapClckT f $ ClckT $ withRouteT (\f -> clckShowFn) $ unClckT $ unXMLGenT $ (_themeTemplate theme ttl hdrXml bdyXml)+    where+      f :: ServerPartT IO (a, ClckState) -> ReaderT BugsConfig (ServerPartT IO) (a, ClckState)+      f m = ReaderT $ \_ -> m++--       fmap toResponse $+--            themeTemplate p ttl <%> <link rel="stylesheet" type="text/css" href=(BugsData "style.css") /> <% hdrs %></%> bdy++--       let pageTemplate = undefined -- <- bugsPageTemplate <$> ask+--       undefined+{-+       fmap toResponse $ unXMLGenT $+            pageTemplate ttl <%> <link rel="stylesheet" type="text/css" href=(BugsData "style.css") /> <% hdrs %></%> bdy+-}
+ Clckwrks/Bugs/Page/Timeline.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.Page.Timeline where++import Clckwrks+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Types+import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Page.Template (template)+import qualified Data.IxSet as IxSet+import Data.List (find)+import Data.String (fromString)+import Numeric (showFFloat)++timeline :: BugsM Response+timeline =+    template (fromString "Timeline") ()+        <%>+          <h1>Timeline</h1>+          <% timelineWidget %>+        </%>++timelineWidget :: XMLGenT BugsM XML+timelineWidget =+    do ms     <- query GetMilestones+       ixBugs <- query $ BugsForMilestones (map milestoneId ms)+       <div class="timeline">+        <% mapM (showMilestone ms) (IxSet.groupBy ixBugs) %>+       </div>++showMilestone :: [Milestone] -> (MilestoneId, [Bug]) -> XMLGenT BugsM [ChildType BugsM]+showMilestone ms (mid, bugs) =+    case find (\m -> milestoneId m == mid) ms of+      Nothing -> <%>internal error: showMilestone - not found <% show mid %></%>+      (Just m) ->+       do completed <- query (MilestoneCompletion mid)+          <%>+           <h2><% milestoneTitle m %></h2>+           <% maybe (return $ cdata "") meter completed %>+           <table>+            <thead>+             <tr>+              <th>BugId</th>+              <th>Summary</th>+             </tr>+            </thead>+            <tbody>+             <% mapM showBugSummary bugs %>+            </tbody>+           </table>+          </%>++showBugSummary :: Bug -> XMLGenT BugsM XML+showBugSummary Bug{..} =+    <tr ["class" := (if (bugStatus == New) || (bugStatus == Accepted) then "bug-summary-open" else "bug-summary-closed")] >+     <td><a href=(ViewBug bugId)><% bugId %></a></td>+     <td><% bugTitle %></td>+    </tr>++meter :: (Real a)+      => a -- ^ a number between 0 and 1 indicating percentage complete+      -> XMLGenT BugsM XML+meter completed =+    <div class="meter">+      <span style=("width: " ++ (showFFloat (Just 3) ((fromRational (toRational completed)) * 100) "%"))></span>+    </div>
+ Clckwrks/Bugs/Page/ViewBug.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleContexts, RecordWildCards #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.Page.ViewBug where++import Clckwrks+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Types+import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Page.Template (template)+import Clckwrks.ProfileData.Acid+import Data.Maybe (fromMaybe, maybe)+import Data.Set   (Set)+import qualified Data.Set as Set+import Data.String (fromString)+import Data.Text  (pack)++import Happstack.Auth (AuthState, ProfileState)+import Control.Monad.State++viewBug :: BugId -> BugsM Response+viewBug bid =+    do mBug <- query (GetBugById bid)+       case mBug of+         Nothing -> do notFound ()+                       template (fromString "bug not found.") ()+                        <p>Could not find Bug #<% show $ unBugId bid %></p>+         (Just bug) -> bugHtml bug++bugHtml :: Bug -> BugsM Response+bugHtml Bug{..} =+    do submittor       <- query (GetUsername bugSubmittor)+       milestoneTxt <-+           case bugMilestone of+             Nothing  -> return (pack "none")+             Just mid ->+                 fromMaybe (pack $ show mid) <$> query (GetMilestoneTitle mid)+       template (fromString $ "Bug #" ++ (show $ unBugId bugId)) ()+         <%>+           <dl id="view-bug">+            <dt>Bug #:</dt>       <dd><% show $ unBugId bugId %></dd>+            <dt>Submitted By:</dt><dd><% fromMaybe (pack "Anonymous") submittor %></dd>+            <dt>Submitted:</dt>   <dd><% bugSubmitted %></dd>+            <dt>Status:</dt>      <dd><% show bugStatus %></dd>+            <dt>Milestone:</dt>   <dd><% milestoneTxt %></dd>+            <dt>Title:</dt>       <dd><% bugTitle %></dd>+            <dt>Body:</dt>        <dd><% bugBody %></dd>+            <% whenHasRole (Set.singleton Administrator) <a href=(BugsAdmin (EditBug bugId))>edit</a> %>+           </dl>+         </%>++whenHasRole :: (Happstack m, GetAcidState m AuthState+               , GetAcidState m ProfileState+               , GetAcidState m ProfileDataState+               , MonadState ClckState m+               ) =>+     Set Role -> m XML -> m XML+whenHasRole role xml =+    do muid <- getUserId+       case muid of+         (Just uid) ->+             do b <- query (HasRole uid role)+                if b+                  then xml+                  else return $ cdata ""+         _ -> return $ cdata ""
+ Clckwrks/Bugs/Plugin.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE RecordWildCards, FlexibleContexts, OverloadedStrings #-}+module Clckwrks.Bugs.Plugin where++import Clckwrks+import Clckwrks.Plugin+import Clckwrks.Bugs.URL+import Clckwrks.Bugs.Acid+import Clckwrks.Bugs.PreProcess    (bugsCmd)+import Clckwrks.Bugs.Monad+import Clckwrks.Bugs.Route+import Control.Monad.State         (get)+import Data.Acid.Local+import Data.Text                   (Text)+import qualified Data.Text.Lazy    as TL+import Data.Maybe                  (fromMaybe)+import System.FilePath             ((</>))+import Web.Plugins.Core            (Plugin(..), When(Always), addCleanup, addHandler, getConfig, getPluginRouteFn, initPlugin)++bugsHandler :: (BugsURL -> [(Text, Maybe Text)] -> Text)+            -> BugsConfig+            -> ClckPlugins+            -> [Text]+            -> ClckT ClckURL (ServerPartT IO) Response+bugsHandler showBugsURL bugsConfig plugins paths =+    case parseSegments fromPathSegments paths of+      (Left e)  -> notFound $ toResponse (show e)+      (Right u) ->+          ClckT $ withRouteT flattenURL $ unClckT $ runBugsT bugsConfig $ routeBugs u+    where+      flattenURL ::   ((url' -> [(Text, Maybe Text)] -> Text) -> (BugsURL -> [(Text, Maybe Text)] -> Text))+      flattenURL _ u p = showBugsURL u p++bugsInit :: ClckPlugins+         -> IO (Maybe Text)+bugsInit plugins =+    do (Just bugsShowFn) <- getPluginRouteFn plugins (pluginName bugsPlugin)+       (Just clckShowFn) <- getPluginRouteFn plugins (pluginName clckPlugin)+       mTopDir <- clckTopDir <$> getConfig plugins+       let basePath = maybe "_state" (\td -> td </> "_state") mTopDir -- FIXME+       acid <- openLocalStateFrom (basePath </> "bugs") initialBugsState+       addCleanup plugins Always (createCheckpointAndClose acid)+       let bugsConfig = BugsConfig { bugsDirectory = "bugs-dir"+                                   , bugsState     = acid+                                   , bugsClckURL   = clckShowFn+                                   }+       addPreProc plugins (bugsCmd bugsShowFn)+       addHandler plugins (pluginName bugsPlugin) (bugsHandler bugsShowFn bugsConfig)+       return Nothing++addBugsAdminMenu :: ClckT url IO ()+addBugsAdminMenu =+    do p <- plugins <$> get+       (Just showBugsURL) <- getPluginRouteFn p (pluginName bugsPlugin)+       let editMilestonesURL = showBugsURL (BugsAdmin EditMilestones) []+       addAdminMenu ("Bugs", [("Edit Milestones", editMilestonesURL)])+++bugsPlugin :: Plugin BugsURL Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig [TL.Text -> ClckT ClckURL IO TL.Text]+bugsPlugin = Plugin+    { pluginName       = "bugs"+    , pluginInit       = bugsInit+    , pluginDepends    = []+    , pluginToPathInfo = toPathInfo+    , pluginPostHook   = addBugsAdminMenu+    }++plugin :: ClckPlugins -- ^ plugins+       -> Text        -- ^ baseURI+       -> IO (Maybe Text)+plugin plugins baseURI =+    initPlugin plugins baseURI bugsPlugin
+ Clckwrks/Bugs/PreProcess.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Bugs.PreProcess where++import Control.Monad.Trans+import Control.Applicative+import Clckwrks                         (ClckT, ClckState)+import Clckwrks.Bugs.URL                (BugsURL(..))+import Clckwrks.Bugs.Page.Timeline      (timelineWidget)+import Clckwrks.Bugs.Types              (BugId(..))+import Clckwrks.Monad                   (transform, segments)+import Data.Attoparsec.Text.Lazy        (Parser, Result(..), char, choice, decimal, parse, skipMany, space, stringCI, skipMany)+import Data.Monoid                      (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 Web.Routes                       (showURL)++data BugsCmd+    = ShowBug BugId+    | ShowTimeline++parseAttr :: Text -> Parser ()+parseAttr name =+    do skipMany space+       stringCI name+       skipMany space+       char '='+       skipMany space+{-+bugsCmd :: (BugsURL -> [(Text, Maybe Text)] -> Text) -> Parser Builder+bugsCmd showBugsURL =+    bugId showBugsURL++bugId :: (BugsURL -> [(Text, Maybe Text)] -> Text) -> Parser Builder+bugId showBugsURL =+    do parseAttr "id"+       bid <- BugId <$> decimal+       let html = evalIdentity $ <a href=(showBugsURL (ViewBug bid) [])>#<% show $ unBugId bid  %></a>+       return $ B.fromString $ concat $ lines $ renderAsHTML html+-}+parseCmd :: Parser BugsCmd+parseCmd =+    choice [ parseAttr (pack "id") *> (ShowBug . BugId <$> decimal)+           , stringCI (pack "timeline") *> pure ShowTimeline+           ]++bugsCmd :: (Functor m, Monad m) =>+           (BugsURL -> [(Text, Maybe Text)] -> Text)+        -> TL.Text+        -> ClckT url m TL.Text+bugsCmd bugsShowURL txt =+    case parse (segments "bugs" parseCmd) txt of+      (Fail _ _ e) -> return (TL.pack e)+      (Done _ segments) ->+          do b <- transform (applyCmd bugsShowURL) segments+             return $ B.toLazyText b++applyCmd bugsShowURL (ShowBug bid) =+    do html <- unXMLGenT $ <a href=(bugsShowURL (ViewBug bid) [])>#<% show $ unBugId bid  %></a>+       return $ B.fromString $ concat $ lines $ renderAsHTML html+{-+applyCmd bugsShowURL ShowTimeline =+    do html <- unXMLGenT $ timelineWidget+       return $ B.fromString $ concat $ lines $ renderAsHTML html+-}++++-- timeline :: +-- timeline ++{-+parseCmd :: Parser BugsCmd+parseCmd =+    choice [ parseAttr (pack "id") *> (ShowBug . BugId <$> decimal)+           , stringCI (pack "timeline") *> pure ShowTimeline+           ]++data BugsCmd+    = ShowBug BugId+    | ShowTimeline++bugsCmd :: (Functor m, Monad m) => (BugsURL -> [(Text, Maybe Text)] -> Text) -> Text -> ClckT url m Builder+bugsCmd+ showURLFn txt =+    do let mi = parseOnly parseCmd txt+       case mi of+         (Left e) ->+               return $ B.fromString e -- FIXME: format the error more nicely or something?+         (Right (ShowBug bid)) ->+             do html <- unXMLGenT $ <a href=(showURLFn (ViewBug bid) [])>#<% show $ unBugId bid  %></a>+                return $ B.fromString $ concat $ lines $ renderAsHTML html+{-+         -- types are not setup to allow us to do this yet :(+         (Right ShowTimeline) ->+             do html <- unXMLGenT $ timelineWidget+                return $ B.fromString $ concat $ lines $ renderAsHTML html+-}++-}
+ Clckwrks/Bugs/Route.hs view
@@ -0,0 +1,54 @@+module Clckwrks.Bugs.Route where++import Control.Applicative          ((<$>))+import Control.Monad.Reader         (ask)+import Control.Monad.Trans          (liftIO)+import Clckwrks                     (Role(..), requiresRole_)+import Clckwrks.Bugs.Monad          (BugsM, BugsConfig(..))+import Clckwrks.Bugs.URL            (BugsURL(..), BugsAdminURL(..))+import Clckwrks.Bugs.Page.EditBug   (editBug)+import Clckwrks.Bugs.Page.EditMilestones (editMilestones)+import Clckwrks.Bugs.Page.SubmitBug (submitBug)+import Clckwrks.Bugs.Page.Timeline  (timeline)+import Clckwrks.Bugs.Page.ViewBug   (viewBug)+import qualified Data.Set           as Set+import Happstack.Server             (Response, notFound, toResponse, serveFile, guessContentTypeM, mimeTypes)+import Happstack.Server.FileServe.BuildingBlocks (isSafePath)+import Network.URI                  (unEscapeString)+import System.FilePath              ((</>), makeRelative, splitDirectories)+import Paths_clckwrks_plugin_bugs   (getDataDir)++checkAuth :: BugsURL+          -> BugsM BugsURL+checkAuth url =+    do showFn <- bugsClckURL <$> ask+       let requiresRole = requiresRole_ showFn+       case url of+         SubmitBug  {} -> requiresRole (Set.singleton Visitor) url+         ViewBug    {} -> return url+         SearchBugs {} -> return url+         BugsAdmin  {} -> requiresRole (Set.singleton Administrator) url+         BugsData   {} -> return url+         Timeline   {} -> return url++routeBugs :: BugsURL+          -> BugsM Response+routeBugs unsecureURL =+    do url <- checkAuth unsecureURL+       case url of+         (ViewBug bid) -> viewBug bid+         SubmitBug     -> submitBug url+         (BugsData fp')  ->+             do bugsDir <- liftIO getDataDir+                let fp'' = makeRelative "/" (unEscapeString fp')+                if not (isSafePath (splitDirectories fp''))+                  then notFound (toResponse ())+                  else serveFile (guessContentTypeM mimeTypes) (bugsDir </> "data" </> fp'')+         Timeline ->+             timeline+         BugsAdmin (EditBug bid) ->+             editBug url bid+         BugsAdmin EditMilestones ->+             editMilestones url+         SearchBugs ->+             notFound $ toResponse "not implemented yet."
+ Clckwrks/Bugs/Types.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TemplateHaskell #-}+module Clckwrks.Bugs.Types where++import Clckwrks+import Data.Data     (Data, Typeable)+import Data.IxSet    (Indexable(..), ixSet, ixFun)+import Data.Maybe    (maybeToList)+import Data.SafeCopy (SafeCopy, base, deriveSafeCopy)+import Data.Text     (Text)+import Data.Time     (UTCTime)+import Data.Set      (Set)+import Web.Routes    (PathInfo(..))++newtype BugId = BugId { unBugId :: Integer }+    deriving (Eq, Ord, Read, Show, Data, Typeable, SafeCopy, PathInfo)++newtype BugTag = BugTag { tagText :: Text }+    deriving (Eq, Ord, Read, Show, Data, Typeable, SafeCopy, PathInfo)++newtype MilestoneId = MilestoneId { unMilestoneId :: Integer }+    deriving (Eq, Ord, Read, Show, Data, Typeable, SafeCopy, PathInfo, Enum)++data Milestone = Milestone+    { milestoneId      :: MilestoneId+    , milestoneTitle   :: Text+    , milestoneTarget  :: Maybe UTCTime+    , milestoneReached :: Maybe UTCTime++    }+    deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''Milestone)++newtype TargetDate = TargetDate UTCTime+    deriving (Eq, Ord, Show, Data, Typeable)++instance Indexable Milestone where+    empty = ixSet [ ixFun ((:[]) . milestoneId)+                  , ixFun (maybe [] (\d -> [TargetDate d]) . milestoneTarget)+                  ]++data BugStatus+    = New+    | Accepted+    | Closed+    | Invalid+    | WontFix+      deriving (Eq, Ord, Read, Show, Data, Typeable, Bounded, Enum)++$(deriveSafeCopy 0 'base ''BugStatus)++data Bug+    = Bug { bugId        :: BugId+          , bugSubmittor :: UserId+          , bugSubmitted :: UTCTime+          , bugStatus    :: BugStatus+          , bugAssigned  :: Maybe UserId+          , bugTitle     :: Text+          , bugBody      :: Markup+          , bugTags      :: Set BugTag+          , bugMilestone :: Maybe MilestoneId+          }+      deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''Bug)++instance Indexable Bug where+    empty = ixSet [ ixFun ((:[]) . bugId)+                  , ixFun (maybeToList . bugMilestone)+                  , ixFun ((:[]) . bugStatus)+                  ]
+ Clckwrks/Bugs/URL.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}+module Clckwrks.Bugs.URL where++import Clckwrks.Bugs.Types (BugId(..))+import Data.Data           (Data, Typeable)+import Web.Routes.TH       (derivePathInfo)++data BugsAdminURL+    = EditBug BugId+    | EditMilestones+      deriving (Eq, Ord, Read, Show, Data, Typeable)+$(derivePathInfo ''BugsAdminURL)++data BugsURL+    = ViewBug BugId+    | SubmitBug+    | SearchBugs+    | BugsAdmin BugsAdminURL+    | BugsData FilePath+    | Timeline+      deriving (Eq, Ord, Read, Show, Data, Typeable)+$(derivePathInfo ''BugsURL)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Jeremy Shaw, SeeReason Partners LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jeremy Shaw nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,13 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple+import Distribution.Simple.Program++trhsxProgram = simpleProgram "trhsx"++main :: IO ()+main = defaultMainWithHooks simpleUserHooks {+         hookedPrograms = [trhsxProgram]+       }
+ clckwrks-plugin-bugs.cabal view
@@ -0,0 +1,63 @@+Name:                clckwrks-plugin-bugs+Version:             0.3.0+Synopsis:            bug tracking plugin for clckwrks+Homepage:            http://clckwrks.com/+License:             BSD3+License-file:        LICENSE+Author:              Jeremy Shaw+Maintainer:          Jeremy Shaw <jeremy@n-heptane.com>+Copyright:           2012 Jeremy Shaw, SeeReason Partners LLC+Category:            Clckwrks+Build-type:          Custom+Cabal-version:       >=1.6+Data-Files:+    data/style.css++Library+  Build-tools:+    trhsx++  Exposed-modules:+    Clckwrks.Bugs+    Clckwrks.Bugs.Acid+    Clckwrks.Bugs.Monad+    Clckwrks.Bugs.Plugin+    Clckwrks.Bugs.Page.EditBug+    Clckwrks.Bugs.Page.EditMilestones+    Clckwrks.Bugs.Page.Template+    Clckwrks.Bugs.Page.Timeline+    Clckwrks.Bugs.Page.SubmitBug+    Clckwrks.Bugs.Page.ViewBug+    Clckwrks.Bugs.PreProcess+    Clckwrks.Bugs.Route+    Clckwrks.Bugs.Types+    Clckwrks.Bugs.URL+    Paths_clckwrks_plugin_bugs++  Build-depends:+    base                    < 5,+    acid-state             >= 0.7,+    attoparsec             == 0.10.*,+    blaze-html             == 0.5.*,+    clckwrks               == 0.13.*,+    containers             >= 0.4 && < 0.6,+    directory              >= 1.1 && < 1.3,+    filepath               >= 1.2 && < 1.4,+    gd                     == 3000.*,+    happstack-authenticate == 0.9.*,+    happstack-server       >= 7.0 && < 7.2,+    happstack-hsp          == 7.1.*,+    hsp                    == 0.7.*,+    ixset                  == 1.0.*,+    magic                  == 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,+    safecopy               >= 0.6,+    time                   == 1.4.*,+    text                   == 0.11.*,+    web-plugins            == 0.1.*,+    web-routes             == 0.27.*,+    web-routes-th          >= 0.21
+ data/style.css view
@@ -0,0 +1,215 @@+#view-bug dt+{+    font-weight: bold;+}++#view-bug dd+{++}++.bugs ol+{+    list-style-type: none;+}++fieldset.bugs+{+    border: 1px solid #aaa;+    margin-left: 3em;+    margin-right: 3em;+    box-shadow: 5px 5px 1px -2px #bbe;+}++.bugs textarea+{+    font-family: monospace;+}++.bugs input[type='text']+{+    font-family: monospace;+}++/* bug summary */+.bug-summary-open+{+}++.bug-summary-closed+{+    text-decoration: line-through+}++/*****************************************************************************+ * meter+ *+ * http://css-tricks.com/css3-progress-bars/+ *+ *****************************************************************************/+++/* bar container */+.meter {+	height: 20px;  /* Can be anything */+	position: relative;+	background: #555;+	-moz-border-radius: 25px;+	-webkit-border-radius: 25px;+	border-radius: 25px;+	padding: 10px;+	-webkit-box-shadow: inset 0 -1px 1px rgba(255,255,255,0.3);+	-moz-box-shadow   : inset 0 -1px 1px rgba(255,255,255,0.3);+	box-shadow        : inset 0 -1px 1px rgba(255,255,255,0.3);+}++/* progress bar */+.meter > span {+	display: block;+	height: 100%;+	   -webkit-border-top-right-radius: 8px;+	-webkit-border-bottom-right-radius: 8px;+	       -moz-border-radius-topright: 8px;+	    -moz-border-radius-bottomright: 8px;+	           border-top-right-radius: 8px;+	        border-bottom-right-radius: 8px;+	    -webkit-border-top-left-radius: 20px;+	 -webkit-border-bottom-left-radius: 20px;+	        -moz-border-radius-topleft: 20px;+	     -moz-border-radius-bottomleft: 20px;+	            border-top-left-radius: 20px;+	         border-bottom-left-radius: 20px;+	background-color: rgb(43,194,83);+	background-image: -webkit-gradient(+	  linear,+	  left bottom,+	  left top,+	  color-stop(0, rgb(43,194,83)),+	  color-stop(1, rgb(84,240,84))+	 );+	background-image: -webkit-linear-gradient(+	  center bottom,+	  rgb(43,194,83) 37%,+	  rgb(84,240,84) 69%+	 );+	background-image: -moz-linear-gradient(+	  center bottom,+	  rgb(43,194,83) 37%,+	  rgb(84,240,84) 69%+	 );+	background-image: -ms-linear-gradient(+	  center bottom,+	  rgb(43,194,83) 37%,+	  rgb(84,240,84) 69%+	 );+	background-image: -o-linear-gradient(+	  center bottom,+	  rgb(43,194,83) 37%,+	  rgb(84,240,84) 69%+	 );+	-webkit-box-shadow:+	  inset 0 2px 9px  rgba(255,255,255,0.3),+	  inset 0 -2px 6px rgba(0,0,0,0.4);+	-moz-box-shadow:+	  inset 0 2px 9px  rgba(255,255,255,0.3),+	  inset 0 -2px 6px rgba(0,0,0,0.4);+	position: relative;+	overflow: hidden;+}+++/* colors */+.orange > span {+	background-color: #f1a165;+	background-image: -webkit-gradient(linear,left top,left bottom,color-stop(0, #f1a165),color-stop(1, #f36d0a));+	background-image: -webkit-linear-gradient(top, #f1a165, #f36d0a);+        background-image: -moz-linear-gradient(top, #f1a165, #f36d0a);+        background-image: -ms-linear-gradient(top, #f1a165, #f36d0a);+        background-image: -o-linear-gradient(top, #f1a165, #f36d0a);+}++.red > span {+	background-color: #f0a3a3;+	background-image: -webkit-gradient(linear,left top,left bottom,color-stop(0, #f0a3a3),color-stop(1, #f42323));+	background-image: -webkit-linear-gradient(top, #f0a3a3, #f42323);+        background-image: -moz-linear-gradient(top, #f0a3a3, #f42323);+        background-image: -ms-linear-gradient(top, #f0a3a3, #f42323);+        background-image: -o-linear-gradient(top, #f0a3a3, #f42323);+}++/* candy stripe */+.meter > span:after {+	content: "";+	position: absolute;+	top: 0; left: 0; bottom: 0; right: 0;+	background-image:+	   -webkit-gradient(linear, 0 0, 100% 100%,+	      color-stop(.25, rgba(255, 255, 255, .2)),+	      color-stop(.25, transparent), color-stop(.5, transparent),+	      color-stop(.5, rgba(255, 255, 255, .2)),+	      color-stop(.75, rgba(255, 255, 255, .2)),+	      color-stop(.75, transparent), to(transparent)+	   );+	background-image:+		-webkit-linear-gradient(+		  -45deg,+	      rgba(255, 255, 255, .2) 25%,+	      transparent 25%,+	      transparent 50%,+	      rgba(255, 255, 255, .2) 50%,+	      rgba(255, 255, 255, .2) 75%,+	      transparent 75%,+	      transparent+	   );+	background-image:+		-moz-linear-gradient(+		  -45deg,+	      rgba(255, 255, 255, .2) 25%,+	      transparent 25%,+	      transparent 50%,+	      rgba(255, 255, 255, .2) 50%,+	      rgba(255, 255, 255, .2) 75%,+	      transparent 75%,+	      transparent+	   );+	background-image:+		-ms-linear-gradient(+		  -45deg,+	      rgba(255, 255, 255, .2) 25%,+	      transparent 25%,+	      transparent 50%,+	      rgba(255, 255, 255, .2) 50%,+	      rgba(255, 255, 255, .2) 75%,+	      transparent 75%,+	      transparent+	   );+	background-image:+		-o-linear-gradient(+		  -45deg,+	      rgba(255, 255, 255, .2) 25%,+	      transparent 25%,+	      transparent 50%,+	      rgba(255, 255, 255, .2) 50%,+	      rgba(255, 255, 255, .2) 75%,+	      transparent 75%,+	      transparent+	   );+	z-index: 1;+	-webkit-background-size: 50px 50px;+	-moz-background-size:    50px 50px;+	background-size:         50px 50px;+	-webkit-animation: move 2s linear infinite;+	   -webkit-border-top-right-radius: 8px;+	-webkit-border-bottom-right-radius: 8px;+	       -moz-border-radius-topright: 8px;+	    -moz-border-radius-bottomright: 8px;+	           border-top-right-radius: 8px;+	        border-bottom-right-radius: 8px;+	    -webkit-border-top-left-radius: 20px;+	 -webkit-border-bottom-left-radius: 20px;+	        -moz-border-radius-topleft: 20px;+	     -moz-border-radius-bottomleft: 20px;+	            border-top-left-radius: 20px;+	         border-bottom-left-radius: 20px;+	overflow: hidden;+}