Compatibility with yesod-core 1.6

Caveat: I'm not sure that the Semigroup instance is compatible with GHC
before 8.4.
This commit is contained in:
Michael Snoyman 2018-07-03 21:47:54 +03:00
parent 8f0861d52e
commit f6020efa00
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
3 changed files with 18 additions and 13 deletions

View File

@ -4,7 +4,7 @@ packages:
- 'blaze-colonnade' - 'blaze-colonnade'
- 'lucid-colonnade' - 'lucid-colonnade'
- 'siphon' - 'siphon'
# - 'yesod-colonnade' - 'yesod-colonnade'
# - 'geolite-csv' # - 'geolite-csv'
# Dependency packages to be pulled from upstream that are not in the resolver # Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3) # (e.g., acme-missiles-0.3)

View File

@ -22,10 +22,11 @@ module Yesod.Colonnade
) where ) where
import Yesod.Core import Yesod.Core
import Yesod.Core.Types (Body(..),GWData(..),WidgetT(..)) import Yesod.Core.Types (Body(..),GWData(..),WidgetFor(..),wdRef)
import Colonnade (Colonnade,Headed,Headless) import Colonnade (Colonnade,Headed,Headless)
import Data.Text (Text) import Data.Text (Text)
import Control.Monad import Control.Monad
import Data.IORef (modifyIORef')
import Data.Monoid import Data.Monoid
import Data.String (IsString(..)) import Data.String (IsString(..))
import Text.Blaze (Attribute,toValue) import Text.Blaze (Attribute,toValue)
@ -47,9 +48,11 @@ data Cell site = Cell
instance IsString (Cell site) where instance IsString (Cell site) where
fromString = stringCell fromString = stringCell
instance Semigroup (Cell site) where
Cell a1 c1 <> Cell a2 c2 = Cell (mappend a1 a2) (mappend c1 c2)
instance Monoid (Cell site) where instance Monoid (Cell site) where
mempty = Cell mempty mempty mempty = Cell mempty mempty
mappend (Cell a1 c1) (Cell a2 c2) = Cell (mappend a1 a2) (mappend c1 c2) mappend = (<>)
-- | Create a 'Cell' from a 'Widget' -- | Create a 'Cell' from a 'Widget'
cell :: WidgetT site IO () -> Cell site cell :: WidgetT site IO () -> Cell site
@ -189,12 +192,14 @@ li_ = liftParent H.li
a_ = liftParent H.a a_ = liftParent H.a
liftParent :: (Html -> Html) -> Attribute -> WidgetT site IO a -> WidgetT site IO a liftParent :: (Html -> Html) -> Attribute -> WidgetT site IO a -> WidgetT site IO a
liftParent el attrs (WidgetT f) = WidgetT $ \hdata -> do liftParent el attrs (WidgetFor f) = WidgetFor $ \hdata -> do
(a,gwd) <- f hdata a <- f hdata
let Body bodyFunc = gwdBody gwd modifyIORef' (wdRef hdata) $ \gwd ->
newBodyFunc render = let Body bodyFunc = gwdBody gwd
el H.! attrs $ (bodyFunc render) newBodyFunc render =
return (a,gwd { gwdBody = Body newBodyFunc }) el H.! attrs $ (bodyFunc render)
in gwd { gwdBody = Body newBodyFunc }
return a

View File

@ -17,11 +17,11 @@ library
exposed-modules: exposed-modules:
Yesod.Colonnade Yesod.Colonnade
build-depends: build-depends:
base >= 4.9 && < 4.11 base >= 4.9 && < 4.12
, colonnade >= 1.2 && < 1.3 , colonnade >= 1.2 && < 1.3
, yesod-core >= 1.4 && < 1.5 , yesod-core >= 1.6 && < 1.7
, conduit >= 1.2 && < 1.3 , conduit >= 1.3 && < 1.4
, conduit-extra >= 1.2 && < 1.3 , conduit-extra >= 1.3 && < 1.4
, text >= 1.0 && < 1.3 , text >= 1.0 && < 1.3
, blaze-markup >= 0.7 && < 0.9 , blaze-markup >= 0.7 && < 0.9
, blaze-html >= 0.8 && < 0.10 , blaze-html >= 0.8 && < 0.10