diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index f0a8f93b..c7799b7c 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -73,7 +73,7 @@ newtype SessionBackend = SessionBackend -> IO (SessionMap, SaveSession) -- ^ Return the session data and a function to save the session } -data SessionCookie = SessionCookie (Either UTCTime ByteString) ByteString SessionMap +data SessionCookie = SessionCookie !(Either UTCTime ByteString) !ByteString !SessionMap deriving (Show, Read) instance Serialize SessionCookie where put (SessionCookie a b c) = do @@ -151,13 +151,13 @@ data Approot master = ApprootRelative -- ^ No application root. type ResolvedApproot = Text -data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text +data AuthResult = Authorized | AuthenticationRequired | Unauthorized !Text deriving (Eq, Show, Read) data ScriptLoadPosition master = BottomOfBody | BottomOfHeadBlocking - | BottomOfHeadAsync (BottomOfHeadAsync master) + | BottomOfHeadAsync !(BottomOfHeadAsync master) type BottomOfHeadAsync master = [Text] -- ^ urls to load asynchronously @@ -170,7 +170,7 @@ type Texts = [Text] newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application } -- | Like 'WaiSubsite', but applies parent site's middleware and isAuthorized. --- +-- -- @since 1.4.34 newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application } @@ -201,7 +201,7 @@ data YesodRunnerEnv site = YesodRunnerEnv , yreSessionBackend :: !(Maybe SessionBackend) , yreGen :: !(IO Int) -- ^ Generate a random number - , yreGetMaxExpires :: IO Text + , yreGetMaxExpires :: !(IO Text) } data YesodSubRunnerEnv sub parent parentMonad = YesodSubRunnerEnv @@ -228,12 +228,12 @@ type instance MonadRoute IO = () type instance MonadRoute (HandlerT site m) = (Route site) data GHState = GHState - { ghsSession :: SessionMap - , ghsRBC :: Maybe RequestBodyContents - , ghsIdent :: Int - , ghsCache :: TypeMap - , ghsCacheBy :: KeyedTypeMap - , ghsHeaders :: Endo [Header] + { ghsSession :: !SessionMap + , ghsRBC :: !(Maybe RequestBodyContents) + , ghsIdent :: !Int + , ghsCache :: !TypeMap + , ghsCacheBy :: !KeyedTypeMap + , ghsHeaders :: !(Endo [Header]) } -- | An extension of the basic WAI 'W.Application' datatype to provide extra @@ -281,9 +281,9 @@ newtype CssBuilder = CssBuilder { unCssBuilder :: TBuilder.Builder } -- -- > PageContent url -> HtmlUrl url data PageContent url = PageContent - { pageTitle :: Html - , pageHead :: HtmlUrl url - , pageBody :: HtmlUrl url + { pageTitle :: !Html + , pageHead :: !(HtmlUrl url) + , pageBody :: !(HtmlUrl url) } data Content = ContentBuilder !BB.Builder !(Maybe Int) -- ^ The content and optional content length. @@ -310,11 +310,11 @@ newtype DontFullyEvaluate a = DontFullyEvaluate { unDontFullyEvaluate :: a } -- | Responses to indicate some form of an error occurred. data ErrorResponse = NotFound - | InternalError Text - | InvalidArgs [Text] + | InternalError !Text + | InvalidArgs ![Text] | NotAuthenticated - | PermissionDenied Text - | BadMethod H.Method + | PermissionDenied !Text + | BadMethod !H.Method deriving (Show, Eq, Typeable, Generic) instance NFData ErrorResponse where rnf = genericRnf @@ -322,9 +322,11 @@ instance NFData ErrorResponse where ----- header stuff -- | Headers to be added to a 'Result'. data Header = - AddCookie SetCookie - | DeleteCookie ByteString ByteString - | Header ByteString ByteString + AddCookie !SetCookie + | DeleteCookie !ByteString !ByteString + -- ^ name and path + | Header !ByteString !ByteString + -- ^ key and value deriving (Eq, Show) -- FIXME In the next major version bump, let's just add strictness annotations @@ -335,16 +337,16 @@ instance NFData Header where rnf (DeleteCookie x y) = x `seq` y `seq` () rnf (Header x y) = x `seq` y `seq` () -data Location url = Local url | Remote Text +data Location url = Local !url | Remote !Text deriving (Show, Eq) -- | A diff list that does not directly enforce uniqueness. -- When creating a widget Yesod will use nub to make it unique. newtype UniqueList x = UniqueList ([x] -> [x]) -data Script url = Script { scriptLocation :: Location url, scriptAttributes :: [(Text, Text)] } +data Script url = Script { scriptLocation :: !(Location url), scriptAttributes :: ![(Text, Text)] } deriving (Show, Eq) -data Stylesheet url = Stylesheet { styleLocation :: Location url, styleAttributes :: [(Text, Text)] } +data Stylesheet url = Stylesheet { styleLocation :: !(Location url), styleAttributes :: ![(Text, Text)] } deriving (Show, Eq) newtype Title = Title { unTitle :: Html } @@ -380,13 +382,13 @@ instance Monoid (GWData a) where instance Semigroup (GWData a) data HandlerContents = - HCContent H.Status !TypedContent - | HCError ErrorResponse - | HCSendFile ContentType FilePath (Maybe FilePart) - | HCRedirect H.Status Text - | HCCreated Text - | HCWai W.Response - | HCWaiApp W.Application + HCContent !H.Status !TypedContent + | HCError !ErrorResponse + | HCSendFile !ContentType !FilePath !(Maybe FilePart) + | HCRedirect !H.Status !Text + | HCCreated !Text + | HCWai !W.Response + | HCWaiApp !W.Application deriving Typeable instance Show HandlerContents where