parent
5070403ce8
commit
1b42873f12
@ -111,24 +111,7 @@ sinkSubmission sheetId userId mExists = do
|
|||||||
matchesUnderlying
|
matchesUnderlying
|
||||||
| not (null underlyingFiles) = all (~~ file) [ f | (Entity _ f, Entity _ sf) <- underlyingFiles ]
|
| not (null underlyingFiles) = all (~~ file) [ f | (Entity _ f, Entity _ sf) <- underlyingFiles ]
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles
|
undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ]
|
||||||
]
|
|
||||||
|
|
||||||
a /~ b = not $ a ~~ b
|
|
||||||
|
|
||||||
(~~) :: File -> File -> Bool
|
|
||||||
(~~) = (==)
|
|
||||||
-- The Eq Instance for File compares modification time exactly even
|
|
||||||
-- though zip archives have very limited accuracy and range regarding
|
|
||||||
-- timestamps.
|
|
||||||
-- We thus expect to replace files a little more often than is actually
|
|
||||||
-- necessary.
|
|
||||||
-- This was done on the premise that changes in file modification time
|
|
||||||
-- break file identity under upload and re-download.
|
|
||||||
--
|
|
||||||
-- Similarly the check whether the new version matches the underlying
|
|
||||||
-- file is arguably too agressive, marking files, differing only in
|
|
||||||
-- modification time, as modified.
|
|
||||||
|
|
||||||
when anyChanges $ do
|
when anyChanges $ do
|
||||||
touchSubmission
|
touchSubmission
|
||||||
@ -179,6 +162,23 @@ sinkSubmission sheetId userId mExists = do
|
|||||||
, SubmissionRatingComment =. ratingComment
|
, SubmissionRatingComment =. ratingComment
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
a /~ b = not $ a ~~ b
|
||||||
|
|
||||||
|
(~~) :: File -> File -> Bool
|
||||||
|
(~~) a b
|
||||||
|
| isUpdate = fileTitle a == fileTitle b && fileContent a == fileContent b
|
||||||
|
| otherwise = a == b
|
||||||
|
-- The Eq Instance for File compares modification time exactly even
|
||||||
|
-- though zip archives have very limited accuracy and range regarding
|
||||||
|
-- timestamps.
|
||||||
|
-- We thus expect to replace files a little more often than is actually
|
||||||
|
-- necessary.
|
||||||
|
-- This was done on the premise that changes in file modification time
|
||||||
|
-- break file identity under upload and re-download.
|
||||||
|
--
|
||||||
|
-- The check whether the new version matches the underlying file is
|
||||||
|
-- more lenient, considering only filename and -content.
|
||||||
|
|
||||||
touchSubmission :: StateT SubmissionSinkState (YesodDB UniWorX) ()
|
touchSubmission :: StateT SubmissionSinkState (YesodDB UniWorX) ()
|
||||||
touchSubmission = do
|
touchSubmission = do
|
||||||
alreadyTouched <- gets $ getAny . sinkSubmissionTouched
|
alreadyTouched <- gets $ getAny . sinkSubmissionTouched
|
||||||
|
|||||||
@ -6,10 +6,6 @@ nix:
|
|||||||
extra-package-dbs: []
|
extra-package-dbs: []
|
||||||
packages:
|
packages:
|
||||||
- .
|
- .
|
||||||
- location:
|
|
||||||
git: https://github.com/pngwjpgh/conduit-resumablesink.git
|
|
||||||
commit: ee0679dc31cdcedb2dad240b941262b9dc16f06d
|
|
||||||
extra-dep: true
|
|
||||||
- location:
|
- location:
|
||||||
git: https://github.com/pngwjpgh/zip-stream.git
|
git: https://github.com/pngwjpgh/zip-stream.git
|
||||||
commit: 9272bbed000928d500febad1cdc98d1da29d399e
|
commit: 9272bbed000928d500febad1cdc98d1da29d399e
|
||||||
@ -18,6 +14,7 @@ extra-deps:
|
|||||||
- colonnade-1.1.1
|
- colonnade-1.1.1
|
||||||
- yesod-colonnade-1.1.0
|
- yesod-colonnade-1.1.0
|
||||||
# - zip-stream-0.1.0.1
|
# - zip-stream-0.1.0.1
|
||||||
|
- conduit-resumablesink-0.2
|
||||||
- uuid-crypto-1.3.1.0
|
- uuid-crypto-1.3.1.0
|
||||||
- filepath-crypto-0.0.0.0
|
- filepath-crypto-0.0.0.0
|
||||||
- cryptoids-0.4.0.0
|
- cryptoids-0.4.0.0
|
||||||
|
|||||||
@ -1,33 +0,0 @@
|
|||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
||||||
|
|
||||||
module Handler.Utils.Zip.RatingSpec where
|
|
||||||
|
|
||||||
import TestImport
|
|
||||||
|
|
||||||
import Handler.Utils.Zip.Rating
|
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as Lazy.ByteString
|
|
||||||
|
|
||||||
import qualified Data.Text as Text
|
|
||||||
|
|
||||||
import Database.Persist.Class
|
|
||||||
import Database.Persist.Sql
|
|
||||||
|
|
||||||
|
|
||||||
instance Arbitrary Rating where
|
|
||||||
arbitrary = do
|
|
||||||
ratingCourseName <- arbitrary
|
|
||||||
ratingSheetName <- arbitrary
|
|
||||||
ratingSubmissionId <- SubmissionKey . SqlBackendKey <$> arbitrary
|
|
||||||
ratingComment <- (fmap Text.strip <$> arbitrary) `suchThat` maybe True (not . Text.null)
|
|
||||||
ratingPoints <- arbitrary
|
|
||||||
return Rating{..}
|
|
||||||
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = describe "Rating files" $ do
|
|
||||||
it "have compatible formatting/parsing" . property $
|
|
||||||
\rating@(Rating{..}) -> parseRating (Lazy.ByteString.toStrict $ formatRating rating) >>= (`shouldBe` (ratingPoints, ratingComment))
|
|
||||||
Loading…
Reference in New Issue
Block a user