Strictify a bunch of fields

This commit is contained in:
Michael Snoyman 2018-01-15 15:18:09 +02:00
parent 60f65ed267
commit 89be12c147
No known key found for this signature in database
GPG Key ID: A048E8C057E86876

View File

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