Merge branch 'master' into bylabel-contain

This commit is contained in:
Maximilian Tagher 2018-02-09 22:20:02 -08:00 committed by GitHub
commit a0963e77b2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 70 additions and 29 deletions

View File

@ -76,9 +76,10 @@ matrix:
compiler: ": #stack default osx"
os: osx
- env: BUILD=stack ARGS="--resolver lts-7"
compiler: ": #stack 8.0.1 osx"
os: osx
# malformed mach-o: load commands size (34184) > 32768)
#- env: BUILD=stack ARGS="--resolver lts-7"
# compiler: ": #stack 8.0.1 osx"
# os: osx
- env: BUILD=stack ARGS="--resolver lts-9"
compiler: ": #stack 8.0.2 osx"

View File

@ -37,3 +37,9 @@ extra-deps:
- foundation-0.0.19
- memory-0.14.14
- simple-sendfile-0.2.27
- aeson-1.2.4.0
- http-client-0.5.10
- http-client-tls-0.3.5.2
- websockets-0.12.3.1
- th-abstraction-0.2.6.0
- persistent-template-2.5.3.1

View File

@ -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

View File

@ -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

View File

@ -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.
--
@ -357,10 +359,12 @@ newtype Title = Title { unTitle :: Html }
newtype Head url = Head (HtmlUrl url)
deriving Monoid
instance Semigroup (Head a)
instance Semigroup (Head url) where
(<>) = mappend
newtype Body url = Body (HtmlUrl url)
deriving Monoid
instance Semigroup (Body a)
instance Semigroup (Body url) where
(<>) = mappend
type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder
@ -375,16 +379,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
(mappend a1 b1)
(mappend a2 b2)
(mappend a3 b3)
(mappend a4 b4)
(unionWith mappend a5 b5)
(a6 `mappend` b6)
(a7 `mappend` b7)
instance Semigroup (GWData a)
(mappend a6 b6)
(mappend a7 b7)
data HandlerContents =
HCContent !H.Status !TypedContent
@ -473,8 +480,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

View File

@ -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>

View File

@ -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

View File

@ -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

View File

@ -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>

View File

@ -3,6 +3,10 @@
* Add byLabel-related functions like byLabelContain
[#1482](https://github.com/yesodweb/yesod/pull/1482)
## 1.6.1
* Fix the build with `base-4.11` (GHC 8.4).
## 1.6.0
* Upgrade to yesod-core 1.6.0

View File

@ -164,6 +164,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)
@ -576,9 +577,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.

View File

@ -30,6 +30,7 @@ library
, network >= 2.2
, persistent >= 1.0
, pretty-show >= 1.6
, semigroups
, text
, time
, transformers >= 0.2.2