filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Format indicators

Browse Source
This commit is contained in:
Filip Graliński 2019-02-22 09:53:00 +01:00
parent 81167926bf
commit 87f37df55f
4 changed files with 32 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
Handler/Dashboard.hs
View File

@ -34,9 +34,9 @@ postDashboardR = do
mUser <- maybeAuth mUser <- maybeAuth
when (checkIfAdmin mUser) $ do when (checkIfAdmin mUser) $ do
case result of case result of
FormSuccess (testId, filterCondition, targetCondition, deadlineDay, deadlineTime, value) -> do FormSuccess (testId, mName, filterCondition, targetCondition, deadlineDay, deadlineTime, value) -> do
targetId <- runDB $ insert $ Indicator testId filterCondition targetCondition targetId <- runDB $ insert $ Indicator testId filterCondition targetCondition
_ <- runDB $ insert $ Target targetId (UTCTime { utctDay = deadlineDay, utctDayTime = timeOfDayToTime deadlineTime }) value _ <- runDB $ insert $ Target targetId (UTCTime { utctDay = deadlineDay, utctDayTime = timeOfDayToTime deadlineTime }) value mName
return () return ()
_ -> do _ -> do
return () return ()
@ -81,6 +81,7 @@ doEditIndicator mUser indicatorId formWidget formEnctype = do
indicator <- runDB $ get404 indicatorId indicator <- runDB $ get404 indicatorId
indicatorEntry <- indicatorToEntry (Entity indicatorId indicator) indicatorEntry <- indicatorToEntry (Entity indicatorId indicator)
let mPrecision = testPrecision $ entityVal $ indicatorEntryTest indicatorEntry
defaultLayout $ do defaultLayout $ do
setTitle "Dashboard" setTitle "Dashboard"
$(widgetFile "edit-indicator") $(widgetFile "edit-indicator")
@ -91,8 +92,8 @@ postAddTargetR indicatorId = do
mUser <- maybeAuth mUser <- maybeAuth
when (checkIfAdmin mUser) $ runDB $ do when (checkIfAdmin mUser) $ runDB $ do
case result of case result of
FormSuccess (deadlineDay, deadlineTime, value) -> do FormSuccess (mName, deadlineDay, deadlineTime, value) -> do
_ <- insert $ Target indicatorId (UTCTime { utctDay = deadlineDay, utctDayTime = timeOfDayToTime deadlineTime }) value _ <- insert $ Target indicatorId (UTCTime { utctDay = deadlineDay, utctDayTime = timeOfDayToTime deadlineTime }) value mName
return () return ()
_ -> do _ -> do
return () return ()
@ -149,9 +150,10 @@ indicatorToEntry indicatorEnt@(Entity indicatorId indicator) = runDB $ do
indicatorEntryTargets = targets indicatorEntryTargets = targets
} }
targetForm :: Form (TestId, Maybe Text, Maybe Text, Day, TimeOfDay, Double) targetForm :: Form (TestId, Maybe Text, Maybe Text, Maybe Text, Day, TimeOfDay, Double)
targetForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,) targetForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,)
<$> testSelectFieldList Nothing <$> testSelectFieldList Nothing
<*> aopt textField (bfs MsgTargetName) Nothing
<*> aopt textField (fieldWithTooltip MsgFilterCondition MsgFilterConditionTooltip) Nothing <*> aopt textField (fieldWithTooltip MsgFilterCondition MsgFilterConditionTooltip) Nothing
<*> aopt textField (fieldWithTooltip MsgTargetCondition MsgTargetConditionTooltip) Nothing <*> aopt textField (fieldWithTooltip MsgTargetCondition MsgTargetConditionTooltip) Nothing
<*> areq dayField (bfs MsgTargetDeadlineDay) Nothing <*> areq dayField (bfs MsgTargetDeadlineDay) Nothing
@ -164,9 +166,10 @@ indicatorForm indicator = renderBootstrap3 BootstrapBasicForm $ Indicator
<*> aopt textField (fieldWithTooltip MsgFilterCondition MsgFilterConditionTooltip) (Just $ indicatorFilterCondition indicator) <*> aopt textField (fieldWithTooltip MsgFilterCondition MsgFilterConditionTooltip) (Just $ indicatorFilterCondition indicator)
<*> aopt textField (fieldWithTooltip MsgTargetCondition MsgTargetConditionTooltip) (Just $ indicatorTargetCondition indicator) <*> aopt textField (fieldWithTooltip MsgTargetCondition MsgTargetConditionTooltip) (Just $ indicatorTargetCondition indicator)
addTargetForm :: Form (Day, TimeOfDay, Double) addTargetForm :: Form (Maybe Text, Day, TimeOfDay, Double)
addTargetForm = renderBootstrap3 BootstrapBasicForm $ (,,) addTargetForm = renderBootstrap3 BootstrapBasicForm $ (,,,)
<$> areq dayField (bfs MsgTargetDeadlineDay) Nothing <$> aopt textField (bfs MsgTargetName) Nothing
<*> areq dayField (bfs MsgTargetDeadlineDay) Nothing
<*> areq timeFieldTypeTime (bfs MsgTargetDeadlineTime) Nothing <*> areq timeFieldTypeTime (bfs MsgTargetDeadlineTime) Nothing
<*> areq doubleField (bfs MsgTargetValue) Nothing <*> areq doubleField (bfs MsgTargetValue) Nothing
@ -178,11 +181,12 @@ indicatorTable mUser = mempty
++ Table.text "targets" formatTargets ++ Table.text "targets" formatTargets
++ indicatorStatusCell mUser ++ indicatorStatusCell mUser
targetTable :: Maybe (Entity User) -> Table.Table App (Entity Target) targetTable :: Maybe (Entity User) -> Maybe Int -> Table.Table App (Entity Target)
targetTable mUser = mempty targetTable mUser mPrecision = mempty
++ Table.text "target value" (T.pack . show . targetValue . entityVal) ++ Table.text "target name" ((fromMaybe T.empty) . targetName . entityVal)
++ Table.text "target value" (formatScore mPrecision . targetValue . entityVal)
++ timestampCell "deadline" (targetDeadline . entityVal) ++ timestampCell "deadline" (targetDeadline . entityVal)
++ targetStatusCell mUser ++ targetStatusCell mUser mPrecision
prettyIndicatorEntry :: IndicatorEntry -> Text prettyIndicatorEntry :: IndicatorEntry -> Text
prettyIndicatorEntry entry = prettyTestTitle (entityVal $ indicatorEntryTest entry) prettyIndicatorEntry entry = prettyTestTitle (entityVal $ indicatorEntryTest entry)
@ -192,7 +196,14 @@ formatTargets :: IndicatorEntry -> Text
formatTargets entry = T.intercalate ", " $ (map (formatTarget (testPrecision $ entityVal $ indicatorEntryTest entry))) $ indicatorEntryTargets entry formatTargets entry = T.intercalate ", " $ (map (formatTarget (testPrecision $ entityVal $ indicatorEntryTest entry))) $ indicatorEntryTargets entry
formatTarget :: Maybe Int -> Entity Target -> Text formatTarget :: Maybe Int -> Entity Target -> Text
formatTarget mPrecision (Entity _ target) = (formatScore mPrecision (targetValue target)) <> " (" <> (T.pack $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M" $ targetDeadline target) ++ ")" formatTarget mPrecision (Entity _ target) =
(case targetName target of
Just name -> name <> " "
Nothing -> T.empty)
<> (formatScore mPrecision (targetValue target))
<> " ("
<> (T.pack $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M" $ targetDeadline target)
<> ")"
indicatorStatusCell :: Maybe (Entity User) -> Table.Table App IndicatorEntry indicatorStatusCell :: Maybe (Entity User) -> Table.Table App IndicatorEntry
indicatorStatusCell mUser = Table.widget "" (indicatorStatusCellWidget mUser) indicatorStatusCell mUser = Table.widget "" (indicatorStatusCellWidget mUser)
@ -201,11 +212,11 @@ indicatorStatusCellWidget :: Maybe (Entity User) -> IndicatorEntry -> WidgetFor
indicatorStatusCellWidget mUser indicatorEntry = $(widgetFile "indicator-status") indicatorStatusCellWidget mUser indicatorEntry = $(widgetFile "indicator-status")
where indicatorId = entityKey $ indicatorEntryIndicator indicatorEntry where indicatorId = entityKey $ indicatorEntryIndicator indicatorEntry
targetStatusCell :: Maybe (Entity User) -> Table.Table App (Entity Target) targetStatusCell :: Maybe (Entity User) -> Maybe Int -> Table.Table App (Entity Target)
targetStatusCell mUser = Table.widget "" (targetStatusCellWidget mUser) targetStatusCell mUser mPrecision = Table.widget "" (targetStatusCellWidget mUser mPrecision)
targetStatusCellWidget :: Maybe (Entity User) -> Entity Target -> WidgetFor App () targetStatusCellWidget :: Maybe (Entity User) -> Maybe Int -> Entity Target -> WidgetFor App ()
targetStatusCellWidget mUser targetEnt = $(widgetFile "target-status") targetStatusCellWidget mUser mPrecision targetEnt = $(widgetFile "target-status")
where targetId = entityKey $ targetEnt where targetId = entityKey $ targetEnt
testSelectFieldList :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, RenderMessage site AppMessage, RenderMessage site FormMessage, PersistQueryRead (YesodPersistBackend site), YesodPersist site) => Maybe TestId -> AForm (HandlerFor site) (Key Test) testSelectFieldList :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, RenderMessage site AppMessage, RenderMessage site FormMessage, PersistQueryRead (YesodPersistBackend site), YesodPersist site) => Maybe TestId -> AForm (HandlerFor site) (Key Test)

1
config/models
View File

@ -160,4 +160,5 @@ Target
indicator IndicatorId indicator IndicatorId
deadline UTCTime deadline UTCTime
value Double value Double
name Text Maybe
-- By default this file is used in Model.hs (which is imported by Foundation.hs) -- By default this file is used in Model.hs (which is imported by Foundation.hs)

1
messages/en.msg
View File

@ -75,3 +75,4 @@ TargetDeadlineTime: target time
TargetValue: target value to be reached before the target date TargetValue: target value to be reached before the target date
Test: test Test: test
Dashboard: dashboard Dashboard: dashboard
TargetName: target name

2
templates/edit-indicator.hamlet
View File

@ -7,7 +7,7 @@
<h4>Targets <h4>Targets
^{Table.buildBootstrap (targetTable mUser) (indicatorEntryTargets indicatorEntry)} ^{Table.buildBootstrap (targetTable mUser mPrecision) (indicatorEntryTargets indicatorEntry)}
$if (checkIfAdmin mUser) $if (checkIfAdmin mUser)
<h4>Add a new target <h4>Add a new target