fix(many occurrences throughout the project): Fix typo: occurence -> occurrence everywhere
A typo between occurence in code and occurrence in tests prevented deployment. I changed all occurrences of "occurence" to the correct spelling, such that
This commit is contained in:
Steffen Jost
parent
89d5364c93
commit
96387cbed5
@ -965,8 +965,8 @@ ScheduleRegular: Planmäßiger Termin
|
||||
ScheduleRegularKind: Plan
|
||||
WeekDay: Wochentag
|
||||
Day: Tag
|
||||
OccurenceStart: Beginn
|
||||
OccurenceEnd: Ende
|
||||
OccurrenceStart: Beginn
|
||||
OccurrenceEnd: Ende
|
||||
ScheduleExists: Dieser Plan existiert bereits
|
||||
|
||||
ScheduleExceptions: Termin-Ausnahmen
|
||||
|
||||
@ -4,7 +4,7 @@ Tutorial json
|
||||
type (CI Text) -- "Tutorium", "Zentralübung", ...
|
||||
capacity Int Maybe -- limit for enrolment in this tutorial
|
||||
room Text
|
||||
time Occurences
|
||||
time Occurrences
|
||||
regGroup (CI Text) Maybe -- each participant may register for one tutorial per regGroup
|
||||
registerFrom UTCTime Maybe
|
||||
registerTo UTCTime Maybe
|
||||
|
||||
@ -165,7 +165,7 @@ postAdminTestR = do
|
||||
|
||||
-- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
|
||||
--
|
||||
-- This /needs/ to replace all occurences of @mreq@ with @mpreq@ (no fields should be /actually/ required)
|
||||
-- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required)
|
||||
mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
|
||||
-> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
|
||||
-> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
|
||||
|
||||
@ -360,7 +360,7 @@ getCShowR tid ssh csh = do
|
||||
^{nameEmailWidget' tutor}
|
||||
|]
|
||||
, sortable (Just "room") (i18nCell MsgTutorialRoom) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> textCell tutorialRoom
|
||||
, sortable Nothing (i18nCell MsgTutorialTime) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> occurencesCell tutorialTime
|
||||
, sortable Nothing (i18nCell MsgTutorialTime) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> occurrencesCell tutorialTime
|
||||
, sortable (Just "register-from") (i18nCell MsgTutorialRegisterFrom) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> maybeDateTimeCell tutorialRegisterFrom
|
||||
, sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> maybeDateTimeCell tutorialRegisterTo
|
||||
, sortable (Just "deregister-until") (i18nCell MsgTutorialDeregisterUntil) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> maybeDateTimeCell tutorialDeregisterUntil
|
||||
|
||||
@ -8,7 +8,7 @@ import Handler.Utils.Tutorial
|
||||
import Handler.Utils.Table.Cells
|
||||
import Handler.Utils.Delete
|
||||
import Handler.Utils.Communication
|
||||
import Handler.Utils.Form.Occurences
|
||||
import Handler.Utils.Form.Occurrences
|
||||
import Handler.Utils.Invitations
|
||||
import Jobs.Queue
|
||||
|
||||
@ -64,7 +64,7 @@ getCTutorialListR tid ssh csh = do
|
||||
, sortable (Just "participants") (i18nCell MsgTutorialParticipants) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, n) } -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) . toWidget $ tshow n
|
||||
, sortable (Just "capacity") (i18nCell MsgTutorialCapacity) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybe mempty (textCell . tshow) tutorialCapacity
|
||||
, sortable (Just "room") (i18nCell MsgTutorialRoom) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> textCell tutorialRoom
|
||||
, sortable Nothing (i18nCell MsgTutorialTime) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> occurencesCell tutorialTime
|
||||
, sortable Nothing (i18nCell MsgTutorialTime) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> occurrencesCell tutorialTime
|
||||
, sortable (Just "register-group") (i18nCell MsgTutorialRegGroup) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybe mempty (textCell . CI.original) tutorialRegGroup
|
||||
, sortable (Just "register-from") (i18nCell MsgTutorialRegisterFrom) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybeDateTimeCell tutorialRegisterFrom
|
||||
, sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybeDateTimeCell tutorialRegisterTo
|
||||
@ -275,7 +275,7 @@ data TutorialForm = TutorialForm
|
||||
, tfType :: CI Text
|
||||
, tfCapacity :: Maybe Int
|
||||
, tfRoom :: Text
|
||||
, tfTime :: Occurences
|
||||
, tfTime :: Occurrences
|
||||
, tfRegGroup :: Maybe (CI Text)
|
||||
, tfRegisterFrom :: Maybe UTCTime
|
||||
, tfRegisterTo :: Maybe UTCTime
|
||||
@ -322,7 +322,7 @@ tutorialForm cid template html = do
|
||||
<*> areq (ciField & addDatalist tutTypeDatalist) (fslpI MsgTutorialType $ mr MsgTutorialType) (tfType <$> template)
|
||||
<*> aopt (natFieldI MsgTutorialCapacityNonPositive) (fslpI MsgTutorialCapacity (mr MsgTutorialCapacity) & setTooltip MsgTutorialCapacityTip) (tfCapacity <$> template)
|
||||
<*> areq textField (fslpI MsgTutorialRoom $ mr MsgTutorialRoomPlaceholder) (tfRoom <$> template)
|
||||
<*> occurencesAForm ("occurences" :: Text) (tfTime <$> template)
|
||||
<*> occurrencesAForm ("occurrences" :: Text) (tfTime <$> template)
|
||||
<*> fmap (assertM (not . Text.null . CI.original) . fmap (CI.map Text.strip)) (aopt ciField (fslI MsgTutorialRegGroup & setTooltip MsgTutorialRegGroupTip) ((tfRegGroup <$> template) <|> Just (Just "tutorial")))
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterFrom (mr MsgDate)
|
||||
& setTooltip MsgCourseRegisterFromTip
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
module Handler.Utils.Form.Occurences
|
||||
( occurencesAForm
|
||||
module Handler.Utils.Form.Occurrences
|
||||
( occurrencesAForm
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -12,33 +12,33 @@ import qualified Data.Map as Map
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
|
||||
data OccurenceScheduleKind = ScheduleKindWeekly
|
||||
|
||||
data OccurrenceScheduleKind = ScheduleKindWeekly
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
|
||||
instance Universe OccurenceScheduleKind
|
||||
instance Finite OccurenceScheduleKind
|
||||
instance Universe OccurrenceScheduleKind
|
||||
instance Finite OccurrenceScheduleKind
|
||||
|
||||
nullaryPathPiece ''OccurenceScheduleKind $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''OccurenceScheduleKind id
|
||||
nullaryPathPiece ''OccurrenceScheduleKind $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''OccurrenceScheduleKind id
|
||||
|
||||
data OccurenceExceptionKind = ExceptionKindOccur
|
||||
data OccurrenceExceptionKind = ExceptionKindOccur
|
||||
| ExceptionKindNoOccur
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
|
||||
instance Universe OccurenceExceptionKind
|
||||
instance Finite OccurenceExceptionKind
|
||||
instance Universe OccurrenceExceptionKind
|
||||
instance Finite OccurrenceExceptionKind
|
||||
|
||||
nullaryPathPiece ''OccurenceExceptionKind $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''OccurenceExceptionKind id
|
||||
nullaryPathPiece ''OccurrenceExceptionKind $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''OccurrenceExceptionKind id
|
||||
|
||||
|
||||
occurencesAForm :: PathPiece ident => ident -> Maybe Occurences -> AForm Handler Occurences
|
||||
occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
||||
occurrencesAForm :: PathPiece ident => ident -> Maybe Occurrences -> AForm Handler Occurrences
|
||||
occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
||||
Just cRoute <- getCurrentRoute
|
||||
|
||||
|
||||
let
|
||||
scheduled :: AForm Handler (Set OccurenceSchedule)
|
||||
scheduled :: AForm Handler (Set OccurrenceSchedule)
|
||||
scheduled = Set.fromList <$> massInputAccumA
|
||||
miAdd'
|
||||
miCell'
|
||||
@ -47,16 +47,16 @@ occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
||||
(miIdent' <> "__scheduled" :: Text)
|
||||
(fslI MsgScheduleRegular & setTooltip MsgMassInputTip)
|
||||
False
|
||||
(Set.toList . occurencesScheduled <$> mPrev)
|
||||
(Set.toList . occurrencesScheduled <$> mPrev)
|
||||
where
|
||||
miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurenceSchedule] -> FormResult [OccurenceSchedule])
|
||||
miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurence/form/scheduled-add")) . renderAForm FormStandard . wFormToAForm $ do
|
||||
miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurrenceSchedule] -> FormResult [OccurrenceSchedule])
|
||||
miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurrence/form/scheduled-add")) . renderAForm FormStandard . wFormToAForm $ do
|
||||
newSched <- multiActionW
|
||||
(Map.fromList [ ( ScheduleKindWeekly
|
||||
, ScheduleWeekly
|
||||
<$> apreq (selectField optionsFinite) (fslI MsgWeekDay & addName (nudge "occur-week-day")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurenceStart & addName (nudge "occur-start")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurenceEnd & addName (nudge "occur-end")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
|
||||
)
|
||||
]
|
||||
) (fslI MsgScheduleRegularKind & addName (nudge "kind")) Nothing
|
||||
@ -65,16 +65,16 @@ occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
||||
| newSched' `elem` oldScheds -> FormFailure [mr MsgScheduleExists]
|
||||
| otherwise -> FormSuccess $ pure newSched'
|
||||
|
||||
miCell' :: OccurenceSchedule -> Widget
|
||||
miCell' :: OccurrenceSchedule -> Widget
|
||||
miCell' ScheduleWeekly{..} = do
|
||||
scheduleStart' <- formatTime SelFormatTime scheduleStart
|
||||
scheduleEnd' <- formatTime SelFormatTime scheduleEnd
|
||||
$(widgetFile "widgets/occurence/form/weekly")
|
||||
$(widgetFile "widgets/occurrence/form/weekly")
|
||||
|
||||
miLayout' :: MassInputLayout ListLength OccurenceSchedule ()
|
||||
miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/occurence/form/scheduled-layout")
|
||||
miLayout' :: MassInputLayout ListLength OccurrenceSchedule ()
|
||||
miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/occurrence/form/scheduled-layout")
|
||||
|
||||
exceptions :: AForm Handler (Set OccurenceException)
|
||||
exceptions :: AForm Handler (Set OccurrenceException)
|
||||
exceptions = Set.fromList <$> massInputAccumA
|
||||
miAdd'
|
||||
miCell'
|
||||
@ -83,16 +83,16 @@ occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
||||
(miIdent' <> "__exceptions" :: Text)
|
||||
(fslI MsgScheduleExceptions & setTooltip (UniWorXMessages [SomeMessage MsgScheduleExceptionsTip, SomeMessage MsgMassInputTip]))
|
||||
False
|
||||
(Set.toList . occurencesExceptions <$> mPrev)
|
||||
(Set.toList . occurrencesExceptions <$> mPrev)
|
||||
where
|
||||
miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurenceException] -> FormResult [OccurenceException])
|
||||
miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurence/form/except-add")) . renderAForm FormStandard . wFormToAForm $ do
|
||||
miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurrenceException] -> FormResult [OccurrenceException])
|
||||
miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurrence/form/except-add")) . renderAForm FormStandard . wFormToAForm $ do
|
||||
newExc <- multiActionW
|
||||
(Map.fromList [ ( ExceptionKindOccur
|
||||
, ExceptOccur
|
||||
<$> apreq dayField (fslI MsgDay & addName (nudge "occur-day")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurenceStart & addName (nudge "occur-start")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurenceEnd & addName (nudge "occur-end")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
|
||||
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
|
||||
)
|
||||
, ( ExceptionKindNoOccur
|
||||
, ExceptNoOccur
|
||||
@ -104,20 +104,20 @@ occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
||||
return $ newExc <&> \newExc' oldExcs -> if
|
||||
| newExc' `elem` oldExcs -> FormFailure [mr MsgExceptionExists]
|
||||
| otherwise -> FormSuccess $ pure newExc'
|
||||
|
||||
|
||||
miCell' :: OccurenceException -> Widget
|
||||
|
||||
miCell' :: OccurrenceException -> Widget
|
||||
miCell' ExceptOccur{..} = do
|
||||
exceptStart' <- formatTime SelFormatDateTime (LocalTime exceptDay exceptStart)
|
||||
exceptEnd' <- formatTime SelFormatTime exceptEnd
|
||||
$(widgetFile "widgets/occurence/form/except-occur")
|
||||
$(widgetFile "widgets/occurrence/form/except-occur")
|
||||
miCell' ExceptNoOccur{..} = do
|
||||
exceptTime' <- formatTime SelFormatDateTime exceptTime
|
||||
$(widgetFile "widgets/occurence/form/except-no-occur")
|
||||
$(widgetFile "widgets/occurrence/form/except-no-occur")
|
||||
|
||||
miLayout' :: MassInputLayout ListLength OccurenceException ()
|
||||
miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/occurence/form/except-layout")
|
||||
miLayout' :: MassInputLayout ListLength OccurrenceException ()
|
||||
miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/occurrence/form/except-layout")
|
||||
|
||||
aFormToWForm $ Occurences
|
||||
aFormToWForm $ Occurrences
|
||||
<$> scheduled
|
||||
<*> exceptions
|
||||
@ -14,7 +14,7 @@ import Text.Blaze (ToMarkup(..))
|
||||
import Utils.Lens
|
||||
import Handler.Utils
|
||||
|
||||
import Utils.Occurences
|
||||
import Utils.Occurrences
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
@ -248,19 +248,19 @@ correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
|
||||
correctorLoadCell sc =
|
||||
i18nCell $ sheetCorrectorLoad sc
|
||||
|
||||
occurencesCell :: IsDBTable m a => Occurences -> DBCell m a
|
||||
occurencesCell (normalizeOccurences -> Occurences{..}) = cell $ do
|
||||
let occurencesScheduled' = flip map (Set.toList occurencesScheduled) $ \case
|
||||
occurrencesCell :: IsDBTable m a => Occurrences -> DBCell m a
|
||||
occurrencesCell (normalizeOccurrences -> Occurrences{..}) = cell $ do
|
||||
let occurrencesScheduled' = flip map (Set.toList occurrencesScheduled) $ \case
|
||||
ScheduleWeekly{..} -> do
|
||||
scheduleStart' <- formatTime SelFormatTime scheduleStart
|
||||
scheduleEnd' <- formatTime SelFormatTime scheduleEnd
|
||||
$(widgetFile "widgets/occurence/cell/weekly")
|
||||
occurencesExceptions' = flip map (Set.toList occurencesExceptions) $ \case
|
||||
$(widgetFile "widgets/occurrence/cell/weekly")
|
||||
occurrencesExceptions' = flip map (Set.toList occurrencesExceptions) $ \case
|
||||
ExceptOccur{..} -> do
|
||||
exceptStart' <- formatTime SelFormatDateTime (LocalTime exceptDay exceptStart)
|
||||
exceptEnd' <- formatTime SelFormatTime exceptStart
|
||||
$(widgetFile "widgets/occurence/cell/except-occur")
|
||||
$(widgetFile "widgets/occurrence/cell/except-occur")
|
||||
ExceptNoOccur{..} -> do
|
||||
exceptTime' <- formatTime SelFormatDateTime exceptTime
|
||||
$(widgetFile "widgets/occurence/cell/except-no-occur")
|
||||
$(widgetFile "widgets/occurence/cell")
|
||||
$(widgetFile "widgets/occurrence/cell/except-no-occur")
|
||||
$(widgetFile "widgets/occurrence/cell")
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
Module: Model.Types.DateTime
|
||||
Description: Time related types
|
||||
|
||||
Terms, Seasons, and Occurence schedules
|
||||
Terms, Seasons, and Occurrence schedules
|
||||
-}
|
||||
module Model.Types.DateTime
|
||||
( module Model.Types.DateTime
|
||||
@ -152,7 +152,7 @@ time `withinTerm` term = timeYear `mod` 100 == termYear `mod` 100
|
||||
termYear = year term
|
||||
|
||||
|
||||
data OccurenceSchedule = ScheduleWeekly
|
||||
data OccurrenceSchedule = ScheduleWeekly
|
||||
{ scheduleDayOfWeek :: WeekDay
|
||||
, scheduleStart :: TimeOfDay
|
||||
, scheduleEnd :: TimeOfDay
|
||||
@ -164,9 +164,9 @@ deriveJSON defaultOptions
|
||||
, constructorTagModifier = camelToPathPiece' 1
|
||||
, tagSingleConstructors = True
|
||||
, sumEncoding = TaggedObject "repeat" "schedule"
|
||||
} ''OccurenceSchedule
|
||||
} ''OccurrenceSchedule
|
||||
|
||||
data OccurenceException = ExceptOccur
|
||||
data OccurrenceException = ExceptOccur
|
||||
{ exceptDay :: Day
|
||||
, exceptStart :: TimeOfDay
|
||||
, exceptEnd :: TimeOfDay
|
||||
@ -180,15 +180,15 @@ deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = camelToPathPiece' 1
|
||||
, constructorTagModifier = camelToPathPiece' 1
|
||||
, sumEncoding = TaggedObject "exception" "for"
|
||||
} ''OccurenceException
|
||||
} ''OccurrenceException
|
||||
|
||||
data Occurences = Occurences
|
||||
{ occurencesScheduled :: Set OccurenceSchedule
|
||||
, occurencesExceptions :: Set OccurenceException
|
||||
data Occurrences = Occurrences
|
||||
{ occurrencesScheduled :: Set OccurrenceSchedule
|
||||
, occurrencesExceptions :: Set OccurrenceException
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = camelToPathPiece' 1
|
||||
} ''Occurences
|
||||
derivePersistFieldJSON ''Occurences
|
||||
} ''Occurrences
|
||||
derivePersistFieldJSON ''Occurrences
|
||||
|
||||
|
||||
@ -111,15 +111,15 @@ makeLenses_ ''SubmissionMode
|
||||
|
||||
makePrisms ''E.Value
|
||||
|
||||
makeLenses_ ''OccurenceSchedule
|
||||
makeLenses_ ''OccurrenceSchedule
|
||||
|
||||
makePrisms ''OccurenceSchedule
|
||||
makePrisms ''OccurrenceSchedule
|
||||
|
||||
makeLenses_ ''OccurenceException
|
||||
makeLenses_ ''OccurrenceException
|
||||
|
||||
makePrisms ''OccurenceException
|
||||
makePrisms ''OccurrenceException
|
||||
|
||||
makeLenses_ ''Occurences
|
||||
makeLenses_ ''Occurrences
|
||||
|
||||
makeLenses_ ''PredDNF
|
||||
|
||||
@ -132,6 +132,6 @@ makeLenses_ ''PredDNF
|
||||
|
||||
class HasInstanceID s a | s -> a where
|
||||
instanceID :: Lens' s a
|
||||
|
||||
|
||||
class HasJSONWebKeySet s a | s -> a where
|
||||
jsonWebKeySet :: Lens' s a
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
|
||||
|
||||
module Utils.Occurences
|
||||
( normalizeOccurences
|
||||
module Utils.Occurrences
|
||||
( normalizeOccurrences
|
||||
) where
|
||||
|
||||
import ClassyPrelude
|
||||
@ -20,21 +20,21 @@ import Data.Time
|
||||
import Data.Time.Calendar.WeekDate
|
||||
|
||||
|
||||
normalizeOccurences :: Occurences -> Occurences
|
||||
-- ^
|
||||
normalizeOccurrences :: Occurrences -> Occurrences
|
||||
-- ^
|
||||
--
|
||||
-- - Removes unnecessary exceptions
|
||||
-- - Merges overlapping schedules
|
||||
normalizeOccurences initial
|
||||
normalizeOccurrences initial
|
||||
| Left new <- runReader (runExceptT go) initial
|
||||
= normalizeOccurences new
|
||||
= normalizeOccurrences new
|
||||
| otherwise
|
||||
= initial
|
||||
where
|
||||
go :: ExceptT Occurences (Reader Occurences) ()
|
||||
go :: ExceptT Occurrences (Reader Occurrences) ()
|
||||
-- Find some inconsistency and `throwE` a version without it
|
||||
go = do
|
||||
scheduled <- view _occurencesScheduled
|
||||
scheduled <- view _occurrencesScheduled
|
||||
forM_ scheduled $ \case
|
||||
a@ScheduleWeekly{} -> do
|
||||
let
|
||||
@ -50,35 +50,35 @@ normalizeOccurences initial
|
||||
| otherwise
|
||||
= Nothing
|
||||
merge _ = Nothing
|
||||
merges <- views _occurencesScheduled $ mapMaybe (\b -> (,) <$> pure b <*> merge b) . Set.toList . Set.delete a
|
||||
merges <- views _occurrencesScheduled $ mapMaybe (\b -> (,) <$> pure b <*> merge b) . Set.toList . Set.delete a
|
||||
case merges of
|
||||
[] -> return ()
|
||||
((b, merged) : _) -> throwE =<< asks (over _occurencesScheduled $ Set.insert merged . Set.delete b . Set.delete a)
|
||||
((b, merged) : _) -> throwE =<< asks (over _occurrencesScheduled $ Set.insert merged . Set.delete b . Set.delete a)
|
||||
|
||||
exceptions <- view _occurencesExceptions
|
||||
exceptions <- view _occurrencesExceptions
|
||||
forM_ exceptions $ \case
|
||||
needle@ExceptNoOccur{..} -> do
|
||||
let LocalTime{..} = exceptTime
|
||||
(_, _, toEnum . (`mod` 7) -> localWeekDay) = toWeekDate localDay
|
||||
needed <- views _occurencesScheduled . any $ \case
|
||||
needed <- views _occurrencesScheduled . any $ \case
|
||||
ScheduleWeekly{..} -> and
|
||||
[ scheduleDayOfWeek == localWeekDay
|
||||
, scheduleStart <= localTimeOfDay
|
||||
, localTimeOfDay <= scheduleEnd
|
||||
]
|
||||
unless needed $
|
||||
throwE =<< asks (over _occurencesExceptions $ Set.delete needle)
|
||||
throwE =<< asks (over _occurrencesExceptions $ Set.delete needle)
|
||||
needle@ExceptOccur{..} -> do
|
||||
let (_, _, toEnum . (`mod` 7) -> localWeekDay) = toWeekDate exceptDay
|
||||
-- | Does this ExceptNoOccur target within needle?
|
||||
withinNeedle ExceptNoOccur{..} = LocalTime exceptDay exceptStart <= exceptTime
|
||||
&& exceptTime <= LocalTime exceptDay exceptEnd
|
||||
withinNeedle _ = False
|
||||
needed <- views _occurencesScheduled . none $ \case
|
||||
needed <- views _occurrencesScheduled . none $ \case
|
||||
ScheduleWeekly{..} -> and
|
||||
[ scheduleDayOfWeek == localWeekDay
|
||||
, scheduleStart == exceptStart
|
||||
, scheduleEnd == exceptEnd
|
||||
]
|
||||
unless needed $
|
||||
throwE =<< asks (over _occurencesExceptions $ Set.filter (not . withinNeedle) . Set.delete needle)
|
||||
throwE =<< asks (over _occurrencesExceptions $ Set.filter (not . withinNeedle) . Set.delete needle)
|
||||
@ -1,12 +1,12 @@
|
||||
$newline never
|
||||
<ul .list--inline .list--iconless .list--comma-separated>
|
||||
$forall sched <- occurencesScheduled'
|
||||
$forall sched <- occurrencesScheduled'
|
||||
<li>^{sched}
|
||||
|
||||
$if not (null occurencesExceptions)
|
||||
$if not (null occurrencesExceptions)
|
||||
$# <div .tooltip>
|
||||
$# <div .tooltip__handle .tooltip__handle--danger>
|
||||
$# <div .tooltip__content>
|
||||
<ul>
|
||||
$forall exc <- occurencesExceptions'
|
||||
$forall exc <- occurrencesExceptions'
|
||||
<li>^{exc}
|
||||
@ -586,9 +586,9 @@ fillDb = do
|
||||
, tutorialType = "Tutorium"
|
||||
, tutorialCapacity = Just 30
|
||||
, tutorialRoom = "Hilbert-Raum"
|
||||
, tutorialTime = Occurences
|
||||
{ occurencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 08 15 00) (TimeOfDay 10 00 00)
|
||||
, occurencesExceptions = Set.empty
|
||||
, tutorialTime = Occurrences
|
||||
{ occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 08 15 00) (TimeOfDay 10 00 00)
|
||||
, occurrencesExceptions = Set.empty
|
||||
}
|
||||
, tutorialRegGroup = Just "tutorium"
|
||||
, tutorialRegisterFrom = Just now
|
||||
@ -604,9 +604,9 @@ fillDb = do
|
||||
, tutorialType = "Tutorium"
|
||||
, tutorialCapacity = Just 30
|
||||
, tutorialRoom = "Hilbert-Raum"
|
||||
, tutorialTime = Occurences
|
||||
{ occurencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00)
|
||||
, occurencesExceptions = Set.empty
|
||||
, tutorialTime = Occurrences
|
||||
{ occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00)
|
||||
, occurrencesExceptions = Set.empty
|
||||
}
|
||||
, tutorialRegGroup = Just "tutorium"
|
||||
, tutorialRegisterFrom = Just now
|
||||
|
||||
@ -26,7 +26,7 @@ import Time.Types (WeekDay(..))
|
||||
|
||||
instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where
|
||||
arbitrary = arbitrary `suchThatMap` fromNullable
|
||||
|
||||
|
||||
instance Arbitrary Season where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
@ -71,7 +71,7 @@ instance Arbitrary SheetGradeSummary where
|
||||
instance Arbitrary SheetGroup where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
|
||||
instance Arbitrary SheetTypeSummary where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
@ -79,7 +79,7 @@ instance Arbitrary SheetTypeSummary where
|
||||
instance Arbitrary SheetFileType where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
|
||||
instance Arbitrary SubmissionFileType where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
@ -151,7 +151,7 @@ instance Arbitrary AuthTag where
|
||||
shrink = genericShrink
|
||||
instance CoArbitrary AuthTag where
|
||||
coarbitrary = genericCoarbitrary
|
||||
|
||||
|
||||
instance Arbitrary AuthTagActive where
|
||||
arbitrary = AuthTagActive <$> arbitrary
|
||||
shrink = genericShrink
|
||||
@ -180,7 +180,7 @@ instance Arbitrary AuthenticationMode where
|
||||
authPWHash = unsafePerformIO . fmap decodeUtf8 $ makePasswordWith pwHashAlgorithm pw (pwHashStrength `div` 2)
|
||||
return $ AuthPWHash{..}
|
||||
]
|
||||
|
||||
|
||||
shrink AuthLDAP = []
|
||||
shrink (AuthPWHash _) = [AuthLDAP]
|
||||
|
||||
@ -199,18 +199,18 @@ instance Arbitrary Html where
|
||||
instance Arbitrary WeekDay where
|
||||
arbitrary = oneof $ map pure [minBound..maxBound]
|
||||
|
||||
instance Arbitrary OccurenceSchedule where
|
||||
instance Arbitrary OccurrenceSchedule where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary OccurenceException where
|
||||
instance Arbitrary OccurrenceException where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary Occurences where
|
||||
instance Arbitrary Occurrences where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user