haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use a Deque

Browse Source
This commit is contained in:
Michael Snoyman 2019-02-27 05:26:30 +02:00
parent 9d47aa24da
commit 6bc5feced9
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
4 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
yesod-core/yesod-core.cabal
View File

@ -46,7 +46,7 @@ library
, path-pieces >= 0.1.2 && < 0.3 , path-pieces >= 0.1.2 && < 0.3
, random >= 1.0.0.2 && < 1.2 , random >= 1.0.0.2 && < 1.2
, resourcet >= 1.2 , resourcet >= 1.2
, rio , rio >= 0.1.9
, rio-orphans , rio-orphans
, shakespeare >= 2.0 , shakespeare >= 2.0
, template-haskell >= 2.11 , template-haskell >= 2.11

8
yesod-form/Yesod/Form/Fields.hs
View File

@ -765,7 +765,7 @@ fileAFormReq :: RenderMessage site FormMessage
fileAFormReq fs = AForm $ do fileAFormReq fs = AForm $ do
site <- getYesod site <- getYesod
langs <- reqLangs <$> getRequest langs <- reqLangs <$> getRequest
WFormData viewsRef mfd <- view id WFormData viewsDeque mfd <- view id
ints <- readIORef $ mfdInts mfd ints <- readIORef $ mfdInts mfd
let (name, ints') = let (name, ints') =
case fsName fs of case fsName fs of
@ -796,14 +796,14 @@ $newline never
, fvRequired = True , fvRequired = True
} }
writeIORef (mfdEnctype mfd) Multipart writeIORef (mfdEnctype mfd) Multipart
modifyIORef viewsRef $ \views -> views . (fv:) pushBackDeque viewsDeque fv
return res return res
fileAFormOpt :: FieldSettings site -> AForm site (Maybe FileInfo) fileAFormOpt :: FieldSettings site -> AForm site (Maybe FileInfo)
fileAFormOpt fs = AForm $ do fileAFormOpt fs = AForm $ do
master <- getYesod master <- getYesod
langs <- reqLangs <$> getRequest langs <- reqLangs <$> getRequest
WFormData viewsRef mfd <- view id WFormData viewsDeque mfd <- view id
ints <- readIORef $ mfdInts mfd ints <- readIORef $ mfdInts mfd
let (name, ints') = let (name, ints') =
case fsName fs of case fsName fs of
@ -832,7 +832,7 @@ $newline never
, fvRequired = False , fvRequired = False
} }
writeIORef (mfdEnctype mfd) Multipart writeIORef (mfdEnctype mfd) Multipart
modifyIORef viewsRef $ \views -> views . (fv:) pushBackDeque viewsDeque fv
return res return res
incrInts :: Ints -> Ints incrInts :: Ints -> Ints

16
yesod-form/Yesod/Form/Functions.hs
View File

@ -107,9 +107,9 @@ newFormIdent = do
formToAForm :: MForm site (FormResult a, [FieldView site]) -> AForm site a formToAForm :: MForm site (FormResult a, [FieldView site]) -> AForm site a
formToAForm mform = AForm $ do formToAForm mform = AForm $ do
WFormData viewsRef mfd <- view id WFormData viewsDeque mfd <- view id
(a, views) <- runRIO mfd mform (a, views) <- runRIO mfd mform
modifyIORef' viewsRef $ \front -> front . (views++) for_ views $ pushBackDeque viewsDeque
pure a pure a
aFormToForm :: AForm site a aFormToForm :: AForm site a
@ -162,11 +162,11 @@ wFormToMForm
:: WForm site a -- ^ input form :: WForm site a -- ^ input form
-> MForm site (a, [FieldView site]) -- ^ output form -> MForm site (a, [FieldView site]) -- ^ output form
wFormToMForm wform = do wFormToMForm wform = do
viewsRef <- newIORef id viewsDeque <- newDeque
mfd <- view id mfd <- view id
a <- runRIO (WFormData viewsRef mfd) wform a <- runRIO (WFormData viewsDeque mfd) wform
views <- readIORef viewsRef views <- dequeToList viewsDeque
pure (a, views []) pure (a, views)
-- | Converts a monadic form 'MForm' into another monadic form 'WForm'. -- | Converts a monadic form 'MForm' into another monadic form 'WForm'.
-- --
@ -175,9 +175,9 @@ mFormToWForm
:: MForm site (a, FieldView site) -- ^ input form :: MForm site (a, FieldView site) -- ^ input form
-> WForm site a -- ^ output form -> WForm site a -- ^ output form
mFormToWForm mform = do mFormToWForm mform = do
WFormData views mfd <- view id WFormData viewsDeque mfd <- view id
(a, view') <- runRIO mfd mform (a, view') <- runRIO mfd mform
modifyIORef' views $ \front -> front . (view':) pushBackDeque viewsDeque view'
pure a pure a
-- | Converts a form field into monadic form. This field requires a value -- | Converts a form field into monadic form. This field requires a value

2
yesod-form/Yesod/Form/Types.hs
View File

@ -145,7 +145,7 @@ type FileEnv = Map.Map Text [FileInfo]
-- @since 1.4.14 -- @since 1.4.14
type WForm site = RIO (WFormData site) type WForm site = RIO (WFormData site)
data WFormData site = WFormData data WFormData site = WFormData
{ wfdViews :: !(IORef ([FieldView site] -> [FieldView site])) { wfdViews :: !(BDeque (PrimState IO) (FieldView site))
, wfdMfd :: !(MFormData site) , wfdMfd :: !(MFormData site)
} }
instance HasHandlerData (WFormData site) where instance HasHandlerData (WFormData site) where