fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(dayterms): change termidentifiers to single days complete

Browse Source
This commit is contained in:
Steffen Jost 2021-10-27 20:03:02 +02:00
parent 0c0cb06cdc
commit f807b42089
3 changed files with 184 additions and 809 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Model/Types/DateTime.hs
View File

@ -108,7 +108,7 @@ instance PersistField TermIdentifier where
fromPersistValue x = Left $ "Expected TermIdentifier, received: " <> tshow x
instance PersistFieldSql TermIdentifier where
sqlType _ = SqlNumeric 5 1
sqlType _ = SqlNumeric 9 5 -- total significant digits; significant digits after decimal point
instance ToHttpApiData TermIdentifier where
toUrlPiece = termToText
@ -145,10 +145,10 @@ guessDay :: TermIdentifier
-> Day
guessDay TermIdentifier{..} TermDayLectureStart = getTermDay
guessDay TermIdentifier{..} TermDayLectureEnd = addDays 8 getTermDay -- courses last only a week
guessDay tid TermDayStart = fromWeekDate year weekStart 1 -- Monday before lecture time
where ( year, weekStart, _) = toWeekDate $ guessDay tid TermDayLectureStart
guessDay tid TermDayEnd = fromWeekDate year weekStart 7 -- Sunday after lecture time
where ( year, weekStart, _) = toWeekDate $ guessDay tid TermDayLectureEnd
guessDay tid TermDayStart = fromWeekDate year week 1 -- Monday before lecture time
where ( year, week, _) = toWeekDate $ addDays (-7*4*3) $ guessDay tid TermDayLectureStart
guessDay tid TermDayEnd = fromWeekDate year week 7 -- Sunday after lecture time
where ( year, week, _) = toWeekDate $ addDays (7*3) $ guessDay tid TermDayLectureEnd
withinTerm :: Day -> TermIdentifier -> Bool
withinTerm d tid = guessDay tid TermDayStart <= d && d <= guessDay tid TermDayEnd

972
test/Database/Fill.hs
View File

File diff suppressed because it is too large Load Diff

11
test/Model/TypesSpec.hs
View File

@ -46,6 +46,8 @@ import qualified Data.Text.Lazy as LT
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Handler.Utils.DateTime (getYear)
{-
instance Arbitrary Day where
arbitrary = ModifiedJulianDay <$> choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31
@ -63,7 +65,7 @@ instance CoArbitrary Day where
instance Arbitrary TermIdentifier where
arbitrary = TermIdentifier <$> arbitrary
shrink = fmap TermIdentifier . shrink . tday
shrink = fmap TermIdentifier . shrink . getTermDay
instance CoArbitrary TermIdentifier
instance Function TermIdentifier
@ -387,8 +389,6 @@ spec = do
[ eqLaws, showReadLaws, ordLaws, boundedEnumLaws, finiteLaws, pathPieceLaws ]
lawsCheckHspec (Proxy @Load)
[ eqLaws, showReadLaws, ordLaws, jsonLaws, persistFieldLaws, commutativeSemigroupLaws, commutativeMonoidLaws ]
lawsCheckHspec (Proxy @Season)
[ eqLaws, showReadLaws, ordLaws, boundedEnumLaws ]
lawsCheckHspec (Proxy @TermIdentifier)
[ eqLaws, showReadLaws, ordLaws, enumLaws, persistFieldLaws, jsonLaws, httpApiDataLaws, pathPieceLaws ]
lawsCheckHspec (Proxy @StudyFieldType)
@ -467,8 +467,11 @@ spec = do
\term -> termFromText (termToText term) == Right term
it "has compatible encoding/decoding to/from Rational" . property $
\term -> termFromRational (termToRational term) == term
-- This is not sufficient
--it "has compatible encoding/decoding to/from PersistValue" . property $
-- \term -> fromPersistValue (toPersistValue term) == term
it "has human readable year encoding to Rational" . property $
\term -> truncate (termToRational term) == fst3 $ toGregorian $ tday term
\term -> truncate (termToRational term) == getYear (getTermDay term)
describe "Pseudonym" $ do
it "has sufficient vocabulary" $
(length pseudonymWordlist ^ 2) `shouldSatisfy` (> (fromIntegral (maxBound :: Pseudonym) - fromIntegral (minBound :: Pseudonym)))