Adapt to Semigroup changes in base-4.11
This commit is contained in:
parent
450573ac35
commit
3408e1e630
@ -1,3 +1,9 @@
|
||||
## 1.6.1
|
||||
|
||||
* Add a `Semigroup LiteApp` instance, and explicitly define `(<>)` in the
|
||||
already existing `Semigroup` instances for `WidgetFor`, `Head`, `Body`,
|
||||
`GWData`, and `UniqueList`.
|
||||
|
||||
## 1.6.0
|
||||
|
||||
* Upgrade to conduit 1.3.0
|
||||
|
||||
@ -4,6 +4,9 @@ module Yesod.Core.Internal.LiteApp where
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Data.Monoid
|
||||
#endif
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import Yesod.Routes.Class
|
||||
import Yesod.Core.Class.Yesod
|
||||
import Yesod.Core.Class.Dispatch
|
||||
@ -42,9 +45,14 @@ instance RenderRoute LiteApp where
|
||||
instance ParseRoute LiteApp where
|
||||
parseRoute (x, _) = Just $ LiteAppRoute x
|
||||
|
||||
instance Semigroup LiteApp where
|
||||
LiteApp x <> LiteApp y = LiteApp $ \m ps -> x m ps <|> y m ps
|
||||
|
||||
instance Monoid LiteApp where
|
||||
mempty = LiteApp $ \_ _ -> Nothing
|
||||
mappend (LiteApp x) (LiteApp y) = LiteApp $ \m ps -> x m ps <|> y m ps
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
|
||||
type LiteHandler = HandlerFor LiteApp
|
||||
type LiteWidget = WidgetFor LiteApp
|
||||
|
||||
@ -31,6 +31,7 @@ import Data.IORef (IORef, modifyIORef')
|
||||
import Data.Map (Map, unionWith)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Monoid (Endo (..), Last (..))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
import Data.Serialize (Serialize (..),
|
||||
putByteString)
|
||||
import Data.String (IsString (fromString))
|
||||
@ -55,12 +56,10 @@ import Web.Cookie (SetCookie)
|
||||
import Yesod.Core.Internal.Util (getTime, putTime)
|
||||
import Yesod.Routes.Class (RenderRoute (..), ParseRoute (..))
|
||||
import Control.Monad.Reader (MonadReader (..))
|
||||
import Data.Monoid ((<>))
|
||||
import Control.DeepSeq (NFData (rnf))
|
||||
import Control.DeepSeq.Generics (genericRnf)
|
||||
import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
|
||||
import Control.Monad.Logger (MonadLoggerIO (..))
|
||||
import Data.Semigroup (Semigroup)
|
||||
import UnliftIO (MonadUnliftIO (..), UnliftIO (..))
|
||||
|
||||
-- Sessions
|
||||
@ -255,8 +254,11 @@ data WidgetData site = WidgetData
|
||||
|
||||
instance a ~ () => Monoid (WidgetFor site a) where
|
||||
mempty = return ()
|
||||
mappend x y = x >> y
|
||||
instance a ~ () => Semigroup (WidgetFor site a)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
instance a ~ () => Semigroup (WidgetFor site a) where
|
||||
x <> y = x >> y
|
||||
|
||||
-- | A 'String' can be trivially promoted to a widget.
|
||||
--
|
||||
@ -356,11 +358,9 @@ data Stylesheet url = Stylesheet { styleLocation :: !(Location url), styleAttrib
|
||||
newtype Title = Title { unTitle :: Html }
|
||||
|
||||
newtype Head url = Head (HtmlUrl url)
|
||||
deriving Monoid
|
||||
instance Semigroup (Head a)
|
||||
deriving (Semigroup, Monoid)
|
||||
newtype Body url = Body (HtmlUrl url)
|
||||
deriving Monoid
|
||||
instance Semigroup (Body a)
|
||||
deriving (Semigroup, Monoid)
|
||||
|
||||
type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder
|
||||
|
||||
@ -375,16 +375,19 @@ data GWData a = GWData
|
||||
}
|
||||
instance Monoid (GWData a) where
|
||||
mempty = GWData mempty mempty mempty mempty mempty mempty mempty
|
||||
mappend (GWData a1 a2 a3 a4 a5 a6 a7)
|
||||
(GWData b1 b2 b3 b4 b5 b6 b7) = GWData
|
||||
(a1 `mappend` b1)
|
||||
(a2 `mappend` b2)
|
||||
(a3 `mappend` b3)
|
||||
(a4 `mappend` b4)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
instance Semigroup (GWData a) where
|
||||
GWData a1 a2 a3 a4 a5 a6 a7 <>
|
||||
GWData b1 b2 b3 b4 b5 b6 b7 = GWData
|
||||
(a1 <> b1)
|
||||
(a2 <> b2)
|
||||
(a3 <> b3)
|
||||
(a4 <> b4)
|
||||
(unionWith mappend a5 b5)
|
||||
(a6 `mappend` b6)
|
||||
(a7 `mappend` b7)
|
||||
instance Semigroup (GWData a)
|
||||
(a6 <> b6)
|
||||
(a7 <> b7)
|
||||
|
||||
data HandlerContents =
|
||||
HCContent !H.Status !TypedContent
|
||||
@ -473,8 +476,11 @@ instance MonadLoggerIO (HandlerFor site) where
|
||||
|
||||
instance Monoid (UniqueList x) where
|
||||
mempty = UniqueList id
|
||||
UniqueList x `mappend` UniqueList y = UniqueList $ x . y
|
||||
instance Semigroup (UniqueList x)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
instance Semigroup (UniqueList x) where
|
||||
UniqueList x <> UniqueList y = UniqueList $ x . y
|
||||
|
||||
instance IsString Content where
|
||||
fromString = flip ContentBuilder Nothing . BB.stringUtf8
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod-core
|
||||
version: 1.6.0
|
||||
version: 1.6.1
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
## 1.6.1
|
||||
|
||||
* Explicitly define `(<>)` in the `Semigroup` instance for `Enctype`
|
||||
|
||||
## 1.6.0
|
||||
|
||||
* Upgrade to yesod-core 1.6.0
|
||||
|
||||
@ -104,9 +104,12 @@ instance ToValue Enctype where
|
||||
toValue Multipart = "multipart/form-data"
|
||||
instance Monoid Enctype where
|
||||
mempty = UrlEncoded
|
||||
mappend UrlEncoded UrlEncoded = UrlEncoded
|
||||
mappend _ _ = Multipart
|
||||
instance Semigroup Enctype
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
instance Semigroup Enctype where
|
||||
UrlEncoded <> UrlEncoded = UrlEncoded
|
||||
_ <> _ = Multipart
|
||||
|
||||
data Ints = IntCons Int Ints | IntSingle Int
|
||||
instance Show Ints where
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod-form
|
||||
version: 1.6.0
|
||||
version: 1.6.1
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
## 1.6.1
|
||||
|
||||
* Fix the build with `base-4.11` (GHC 8.4).
|
||||
|
||||
## 1.6.0
|
||||
|
||||
* Upgrade to yesod-core 1.6.0
|
||||
|
||||
@ -158,6 +158,7 @@ import Data.Time.Clock (getCurrentTime)
|
||||
import Control.Applicative ((<$>))
|
||||
import Text.Show.Pretty (ppShow)
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#if MIN_VERSION_base(4,9,0)
|
||||
import GHC.Stack (HasCallStack)
|
||||
#elif MIN_VERSION_base(4,8,1)
|
||||
@ -570,9 +571,6 @@ genericNameFromLabel match label = do
|
||||
name:_ -> return name
|
||||
_ -> failure $ "More than one label contained " <> label
|
||||
|
||||
(<>) :: T.Text -> T.Text -> T.Text
|
||||
(<>) = T.append
|
||||
|
||||
byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains)
|
||||
-> T.Text -- ^ The text contained in the @\<label>@.
|
||||
-> T.Text -- ^ The value to set the parameter to.
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod-test
|
||||
version: 1.6.0
|
||||
version: 1.6.1
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Nubis <nubis@woobiz.com.ar>
|
||||
@ -30,6 +30,7 @@ library
|
||||
, network >= 2.2
|
||||
, persistent >= 1.0
|
||||
, pretty-show >= 1.6
|
||||
, semigroups
|
||||
, text
|
||||
, time
|
||||
, transformers >= 0.2.2
|
||||
|
||||
Loading…
Reference in New Issue
Block a user