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

chore: bump tests

Browse Source
This commit is contained in:
Gregor Kleen 2021-01-11 16:27:10 +01:00
parent ae3f2aa703
commit bce2c953e0
8 changed files with 28 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Utils/DateTime.hs
View File

@ -79,7 +79,7 @@ formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> p
-- formatTime :: (FormatTime t, MonadHandler m, HandlerSite m ~ UniWorX, IsString str) => (DateTimeFormat -> String) -> t -> m str
-- Restricted type for safety
formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX, YesodAuthPersist UniWorX, AuthEntity UniWorX ~ User, AuthId UniWorX ~ UserId) => SelDateTimeFormat -> t -> m Text
formatTime proj t = flip formatTime' t =<< (unDateTimeFormat <$> getDateTimeFormat proj)
formatTime proj t = flip formatTime' t . unDateTimeFormat =<< getDateTimeFormat proj
-- formatTimeH :: (HasLocalTime t) => SelDateTimeFormat -> t -> Handler Text
-- formatTimeH = formatTime

2
src/Handler/Utils/Form.hs
View File

@ -277,7 +277,7 @@ multiActionField minp acts (actField, actExternal, actMessage) fs defAction csrf
, Just (mr -> optionDisplay) <- actMessage act
= flip mappend . over (mapped . _fvInput) (\w -> $(widgetFile "widgets/multi-action/multi-action")) . snd
| otherwise
= flip const
= const id
return ((actionResults Map.!) =<< actionRes, over _fvInput (mappend $ toWidget csrf) actionView : actionViews)

2
src/Handler/Utils/Form/MassInput.hs
View File

@ -307,7 +307,7 @@ massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvR
sentShape <- runMaybeT $ do
ts <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askParams
fs <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askFiles
MaybeT $ either (const Nothing) id <$> lift (fieldParse shapeField ts fs)
MaybeT $ preview (_Right . _Just) <$> lift (fieldParse shapeField ts fs)
sentShape' <- if
| Just s <- sentShape -> return s
| Just iS <- initialShape -> return iS

2
src/Handler/Utils/Memcached.hs
View File

@ -331,7 +331,7 @@ memcachedLimitedWith (doGet, doSet) liftAct (hashableDynamic -> lK) burst rate t
bucket <- Concurrent.newTokenBucket
atomically $ do
hm <- readTVar memcachedLimit
let hm' = HashMap.insertWith (flip const) lK bucket hm
let hm' = HashMap.insertWith (const id) lK bucket hm
writeTVar memcachedLimit $! hm'
return $ HashMap.lookupDefault (error "could not insert new token bucket") lK hm'
sufficientTokens <- liftIO $ Concurrent.tokenBucketTryAlloc bucket burst rate tokens

4
src/Utils/Form.hs
View File

@ -58,6 +58,8 @@ import Data.Monoid (Endo(..))
import Network.URI (URI, parseURI, uriToString)
import Data.Either (fromRight)
--------------------
-- Field Settings --
@ -532,7 +534,7 @@ reorderField optList = Field{..}
fieldView theId name attrs val isReq = do
OptionList{..} <- liftHandler optList
let
isSel n = (==) (either (const $ map optionInternalValue olOptions) id val !! pred n) . optionInternalValue
isSel n = (==) (fromRight (map optionInternalValue olOptions) val !! pred n) . optionInternalValue
nums = map (id &&& withNum theId) [1..length olOptions]
withNum t n = tshow n <> "." <> t
$(widgetFile "widgets/permutation/permutation")

8
src/Utils/Parameters.hs
View File

@ -20,6 +20,8 @@ import Data.Universe
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Lens
data GlobalGetParam = GetLang
| GetReferer
@ -58,7 +60,7 @@ globalGetParamField :: Monad m => GlobalGetParam -> Field m a -> MForm m (Maybe
globalGetParamField ident Field{fieldParse} = runMaybeT $ do
ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
MaybeT $ preview (_Right . _Just) <$> lift (fieldParse ts fs)
data GlobalPostParam = PostFormIdentifier
| PostDeleteTarget
@ -97,13 +99,13 @@ globalPostParamField :: Monad m => GlobalPostParam -> Field m a -> MForm m (Mayb
globalPostParamField ident Field{fieldParse} = runMaybeT $ do
ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
MaybeT $ preview (_Right . _Just) <$> lift (fieldParse ts fs)
globalPostParamFields :: Monad m => GlobalPostParam -> Field m a -> MForm m [a]
globalPostParamFields ident Field{fieldParse} = fmap (fromMaybe []) . runMaybeT $ do
ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
forM ((Left <$> fs) ++ (Right <$> ts)) $ \inp -> MaybeT $ either (const Nothing) id <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)
forM ((Left <$> fs) ++ (Right <$> ts)) $ \inp -> MaybeT $ preview (_Right . _Just) <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)
withGlobalPostParam :: PathPiece result => GlobalPostParam -> result -> (Html -> MForm m a) -> (Html -> MForm m a)
withGlobalPostParam (toPathPiece -> ident) (toPathPiece -> res) f csrf

2
stack.yaml
View File

@ -77,6 +77,8 @@ extra-deps:
- tz-0.1.3.5@sha256:fb17ca50a7d943e511c0ca70342dc83f66aa2532de2745632f1f5f9b1ad783c4,5086
- unidecode-0.1.0.4@sha256:99581ee1ea334a4596a09ae3642e007808457c66893b587e965b31f15cbf8c4d,1144
- wai-middleware-prometheus-1.0.0@sha256:1625792914fb2139f005685be8ce519111451cfb854816e430fbf54af46238b4,1314
- hlint-test-0.1.0.0@sha256:e427c0593433205fc629fb05b74c6b1deb1de72d1571f26142de008f0d5ee7a9,1814
- network-arbitrary-0.6.0.0@sha256:a7034d63295dfc41cf559ee705fc95cac9a9a01b4715300f590eaa237b5ffd48,2506
resolver: nightly-2021-01-11
compiler: ghc-8.10.3

14
stack.yaml.lock
View File

@ -338,6 +338,20 @@ packages:
sha256: 6d64803c639ed4c7204ea6fab0536b97d3ee16cdecb9b4a883cd8e56d3c61402
original:
hackage: wai-middleware-prometheus-1.0.0@sha256:1625792914fb2139f005685be8ce519111451cfb854816e430fbf54af46238b4,1314
- completed:
hackage: hlint-test-0.1.0.0@sha256:e427c0593433205fc629fb05b74c6b1deb1de72d1571f26142de008f0d5ee7a9,1814
pantry-tree:
size: 442
sha256: 347eac6c8a3c02fc0101444d6526b57b3c27785809149b12f90d8db57c721fea
original:
hackage: hlint-test-0.1.0.0@sha256:e427c0593433205fc629fb05b74c6b1deb1de72d1571f26142de008f0d5ee7a9,1814
- completed:
hackage: network-arbitrary-0.6.0.0@sha256:a7034d63295dfc41cf559ee705fc95cac9a9a01b4715300f590eaa237b5ffd48,2506
pantry-tree:
size: 915
sha256: 97b797944cf068eb5fde620e005e253818f03068b2c20e9cfdd3aaa6cafcb678
original:
hackage: network-arbitrary-0.6.0.0@sha256:a7034d63295dfc41cf559ee705fc95cac9a9a01b4715300f590eaa237b5ffd48,2506
snapshots:
- completed:
size: 562265