Yesod.Core.Types created, but it's a mess

yesod-core/Yesod/Content.hs

@@ -63,8 +63,6 @@ import Data.Monoid (mempty)
 
 import Text.Hamlet (Html)
 import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
-import Data.String (IsString (fromString))
-import Network.Wai (FilePart)
 import Data.Conduit (Source, ResourceT, Flush (Chunk), ResumableSource, mapOutput)
 import Data.Conduit.Internal (ResumableSource (ResumableSource))
 
@@ -72,19 +70,12 @@ import qualified Data.Aeson as J
 import Data.Aeson.Encode (fromValue)
 import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
 import Data.Text.Lazy.Builder (toLazyText)
-
+import Yesod.Core.Types
-data Content = ContentBuilder !Builder !(Maybe Int) -- ^ The content and optional content length.
-             | ContentSource !(Source (ResourceT IO) (Flush Builder))
-             | ContentFile !FilePath !(Maybe FilePart)
-             | ContentDontEvaluate !Content
 
 -- | Zero-length enumerator.
 emptyContent :: Content
 emptyContent = ContentBuilder mempty $ Just 0
 
-instance IsString Content where
-    fromString = toContent
-
 -- | Anything which can be converted into 'Content'. Most of the time, you will
 -- want to use the 'ContentBuilder' constructor. An easier approach will be to use
 -- a pre-defined 'toContent' function, such as converting your data into a lazy
@@ -122,12 +113,6 @@ instance ToFlushBuilder Builder where toFlushBuilder = Chunk
 instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap fromByteString
 instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . fromByteString
 
--- | A function which gives targetted representations of content based on the
--- content-types the user accepts.
-type ChooseRep =
-    [ContentType] -- ^ list of content-types user accepts, ordered by preference
- -> IO (ContentType, Content)
-
 -- | Any type which can be converted to representations.
 class HasReps a where
     chooseRep :: a -> ChooseRep
@@ -170,27 +155,20 @@ instance HasReps [(ContentType, Content)] where
       where
         go = simpleContentType
 
-newtype RepHtml = RepHtml Content
 instance HasReps RepHtml where
     chooseRep (RepHtml c) _ = return (typeHtml, c)
-newtype RepJson = RepJson Content
 instance HasReps RepJson where
     chooseRep (RepJson c) _ = return (typeJson, c)
-data RepHtmlJson = RepHtmlJson Content Content
 instance HasReps RepHtmlJson where
     chooseRep (RepHtmlJson html json) = chooseRep
         [ (typeHtml, html)
         , (typeJson, json)
         ]
-newtype RepPlain = RepPlain Content
 instance HasReps RepPlain where
     chooseRep (RepPlain c) _ = return (typePlain, c)
-newtype RepXml = RepXml Content
 instance HasReps RepXml where
     chooseRep (RepXml c) _ = return (typeXml, c)
 
-type ContentType = B.ByteString -- FIXME Text?
-
 typeHtml :: ContentType
 typeHtml = "text/html; charset=utf-8"
 
@@ -256,12 +234,6 @@ formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
 formatRFC822 :: UTCTime -> T.Text
 formatRFC822 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %z"
 
--- | Prevents a response body from being fully evaluated before sending the
--- request.
---
--- Since 1.1.0
-newtype DontFullyEvaluate a = DontFullyEvaluate a
-
 instance HasReps a => HasReps (DontFullyEvaluate a) where
     chooseRep (DontFullyEvaluate a) = fmap (fmap (fmap ContentDontEvaluate)) $ chooseRep a
 

yesod-core/Yesod/Core.hs

@@ -53,8 +53,8 @@ module Yesod.Core
     , module Yesod.Handler
     , module Yesod.Request
     , module Yesod.Widget
-    , module Yesod.Message
     , module Yesod.Core.Json
+    , module Text.Shakespeare.I18N
     ) where
 
 import Yesod.Internal.Core
@@ -64,8 +64,8 @@ import Yesod.Dispatch
 import Yesod.Handler
 import Yesod.Request
 import Yesod.Widget
-import Yesod.Message
 import Yesod.Core.Json
+import Text.Shakespeare.I18N
 
 import Control.Monad.Logger
 

yesod-core/Yesod/Core/Json.hs

@@ -24,7 +24,7 @@ module Yesod.Core.Json
 import Yesod.Handler (GHandler, waiRequest, lift, invalidArgs, redirect)
 import Yesod.Content
     ( ToContent (toContent), RepHtmlJson (RepHtmlJson), RepHtml (RepHtml)
-    , RepJson (RepJson), Content (ContentBuilder)
+    , RepJson (RepJson)
     )
 import Yesod.Internal.Core (defaultLayout, Yesod)
 import Yesod.Widget (GWidget)
@@ -35,16 +35,9 @@ import Control.Monad (join)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Parser as JP
 import Data.Aeson ((.=))
-import qualified Data.Aeson.Encode as JE
-import Data.Aeson.Encode (fromValue)
 import Data.Conduit.Attoparsec (sinkParser)
 import Data.Text (Text, pack)
 import qualified Data.Vector as V
-import Text.Julius (ToJavascript (..))
-import Data.Text.Lazy.Builder (fromLazyText)
-import Data.Text.Lazy.Encoding (decodeUtf8)
-import Data.Text.Lazy.Builder (toLazyText)
-import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
 import Data.Conduit
 import Network.Wai (requestBody, requestHeaders)
 import Network.Wai.Parse (parseHttpAccept)

yesod-core/Yesod/Core/Time.hs

@@ -0,0 +1,29 @@
+module Yesod.Core.Time
+    ( putTime
+    , getTime
+    ) where
+
+import           Data.Int       (Int64)
+import           Data.Serialize (Get, Put, Serialize (..))
+import           Data.Time      (Day (ModifiedJulianDay, toModifiedJulianDay),
+                                 DiffTime, UTCTime (..))
+
+putTime :: UTCTime -> Put
+putTime (UTCTime d t) =
+  let d' = fromInteger  $ toModifiedJulianDay d
+      t' = fromIntegral $ fromEnum (t / diffTimeScale)
+  in put (d' * posixDayLength_int64 + min posixDayLength_int64 t')
+
+getTime :: Get UTCTime
+getTime = do
+  val <- get
+  let (d, t) = val `divMod` posixDayLength_int64
+      d' = ModifiedJulianDay $! fromIntegral d
+      t' = fromIntegral t
+  d' `seq` t' `seq` return (UTCTime d' t')
+
+posixDayLength_int64 :: Int64
+posixDayLength_int64 = 86400
+
+diffTimeScale :: DiffTime
+diffTimeScale = 1e12

yesod-core/Yesod/Core/Trans/Class.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+module Yesod.Core.Trans.Class (MonadLift (..)) where
+
+import Control.Monad.Trans.Class
+
+-- | The standard @MonadTrans@ class only allows lifting for monad
+-- transformers. While @GHandler@ and @GWidget@ should allow lifting, their
+-- types do not express that they actually are transformers. This replacement
+-- class accounts for this.
+class MonadLift base m | m -> base where
+    lift :: base a -> m a
+instance (Monad m, MonadTrans t) => MonadLift m (t m) where
+    lift = Control.Monad.Trans.Class.lift

yesod-core/Yesod/Core/Types.hs

@@ -0,0 +1,417 @@
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TypeFamilies               #-}
+module Yesod.Core.Types where
+
+import qualified Blaze.ByteString.Builder           as BBuilder
+import qualified Blaze.ByteString.Builder.Char.Utf8
+import           Control.Applicative                (Applicative (..))
+import           Control.Applicative                ((<$>))
+import           Control.Arrow                      (first)
+import           Control.Exception                  (Exception, throwIO)
+import           Control.Failure                    (Failure (..))
+import           Control.Monad                      (liftM)
+import           Control.Monad.Base                 (MonadBase (liftBase))
+import           Control.Monad.IO.Class             (MonadIO (liftIO))
+import           Control.Monad.Logger               (LogLevel, LogSource,
+                                                     MonadLogger (..))
+import           Control.Monad.Trans.Control        (MonadBaseControl (..))
+import           Control.Monad.Trans.Resource       (MonadResource (..))
+import           Data.ByteString                    (ByteString)
+import qualified Data.ByteString.Lazy               as L
+import           Data.Conduit                       (Flush, MonadThrow (..),
+                                                     MonadUnsafeIO (..),
+                                                     ResourceT, Source)
+import           Data.IntMap                        (IntMap)
+import           Data.IORef                         (IORef)
+import           Data.Map                           (Map, unionWith)
+import           Data.Monoid                        (Any, Endo (..), Last (..),
+                                                     Monoid (..))
+import           Data.Serialize                     (Serialize (..),
+                                                     putByteString)
+import           Data.String                        (IsString (fromString))
+import           Data.Text                          (Text)
+import qualified Data.Text                          as T
+import qualified Data.Text.Lazy.Builder             as TBuilder
+import           Data.Time                          (UTCTime)
+import           Data.Typeable                      (Typeable)
+import           Language.Haskell.TH.Syntax         (Loc)
+import qualified Network.HTTP.Types                 as H
+import           Network.Wai                        (FilePart,
+                                                     RequestBodyLength)
+import qualified Network.Wai                        as W
+import qualified Network.Wai.Parse                  as NWP
+import           System.Log.FastLogger              (LogStr, toLogStr)
+import           Text.Blaze.Html                    (Html)
+import           Text.Hamlet                        (HtmlUrl)
+import           Text.Julius                        (JavascriptUrl)
+import           Web.Cookie                         (SetCookie)
+import           Yesod.Core.Time                    (getTime, putTime)
+import           Yesod.Core.Trans.Class             (MonadLift (..))
+import           Yesod.Routes.Class                 (RenderRoute (..))
+
+-- Sessions
+type BackendSession = [(Text, ByteString)]
+
+type SaveSession = BackendSession    -- ^ The session contents after running the handler
+                -> IO [Header]
+
+newtype SessionBackend master = SessionBackend
+    { sbLoadSession :: master
+                    -> W.Request
+                    -> IO (BackendSession, SaveSession) -- ^ Return the session data and a function to save the session
+    }
+
+data SessionCookie = SessionCookie (Either UTCTime ByteString) ByteString [(Text, ByteString)]
+    deriving (Show, Read)
+instance Serialize SessionCookie where
+    put (SessionCookie a b c) = do
+        either putTime putByteString a
+        put b
+        put (map (first T.unpack) c)
+
+    get = do
+        a <- getTime
+        b <- get
+        c <- map (first T.pack) <$> get
+        return $ SessionCookie (Left a) b c
+
+data ClientSessionDateCache =
+  ClientSessionDateCache {
+    csdcNow               :: !UTCTime
+  , csdcExpires           :: !UTCTime
+  , csdcExpiresSerialized :: !ByteString
+  } deriving (Eq, Show)
+
+-- | The parsed request information.
+data Request = Request
+    { reqGetParams  :: [(Text, Text)]
+    , reqCookies    :: [(Text, Text)]
+    , reqWaiRequest :: W.Request
+      -- | Languages which the client supports.
+    , reqLangs      :: [Text]
+      -- | A random, session-specific token used to prevent CSRF attacks.
+    , reqToken      :: Maybe Text
+    }
+
+-- | A tuple containing both the POST parameters and submitted files.
+type RequestBodyContents =
+    ( [(Text, Text)]
+    , [(Text, FileInfo)]
+    )
+
+data FileInfo = FileInfo
+    { fileName        :: Text
+    , fileContentType :: Text
+    , fileSource      :: Source (ResourceT IO) ByteString
+    , fileMove        :: FilePath -> IO ()
+    }
+
+data FileUpload = FileUploadMemory (NWP.BackEnd L.ByteString)
+                | FileUploadDisk (NWP.BackEnd FilePath)
+                | FileUploadSource (NWP.BackEnd (Source (ResourceT IO) ByteString))
+
+-- | How to determine the root of the application for constructing URLs.
+--
+-- Note that future versions of Yesod may add new constructors without bumping
+-- the major version number. As a result, you should /not/ pattern match on
+-- @Approot@ values.
+data Approot master = ApprootRelative -- ^ No application root.
+                    | ApprootStatic Text
+                    | ApprootMaster (master -> Text)
+                    | ApprootRequest (master -> W.Request -> Text)
+
+type ResolvedApproot = Text
+
+data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
+    deriving (Eq, Show, Read)
+
+data ScriptLoadPosition master
+    = BottomOfBody
+    | BottomOfHeadBlocking
+    | BottomOfHeadAsync (BottomOfHeadAsync master)
+
+type BottomOfHeadAsync master
+       = [Text] -- ^ urls to load asynchronously
+      -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion
+      -> (HtmlUrl (Route master)) -- ^ widget to insert at the bottom of <head>
+
+newtype Cache = Cache (IntMap Any)
+    deriving Monoid
+
+newtype CacheKey a = CacheKey Int
+
+type Texts = [Text]
+
+-- | Wrap up a normal WAI application as a Yesod subsite.
+newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
+
+data HandlerData sub master = HandlerData
+    { handlerRequest  :: Request
+    , handlerSub      :: sub
+    , handlerMaster   :: master
+    , handlerRoute    :: Maybe (Route sub)
+    , handlerRender   :: Route master -> [(Text, Text)] -> Text
+    , handlerToMaster :: Route sub -> Route master
+    , handlerState    :: IORef GHState
+    , handlerUpload   :: RequestBodyLength -> FileUpload
+    , handlerLog      :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
+    }
+
+-- | A generic handler monad, which can have a different subsite and master
+-- site. We define a newtype for better error message.
+newtype GHandler sub master a = GHandler
+    { unGHandler :: HandlerData sub master -> ResourceT IO a
+    }
+
+data GHState = GHState
+    { ghsSession :: SessionMap
+    , ghsRBC     :: Maybe RequestBodyContents
+    , ghsIdent   :: Int
+    , ghsCache   :: Cache
+    , ghsHeaders :: Endo [Header]
+    }
+
+type SessionMap = Map Text ByteString
+
+-- | An extension of the basic WAI 'W.Application' datatype to provide extra
+-- features needed by Yesod. Users should never need to use this directly, as
+-- the 'GHandler' monad and template haskell code should hide it away.
+newtype YesodApp = YesodApp
+    { unYesodApp
+    :: (ErrorResponse -> YesodApp)
+    -> Request
+    -> [ContentType]
+    -> SessionMap
+    -> ResourceT IO YesodAppResult
+    }
+
+data YesodAppResult
+    = YARWai W.Response
+    | YARPlain H.Status [Header] ContentType Content SessionMap
+
+-- | A generic widget, allowing specification of both the subsite and master
+-- site datatypes. While this is simply a @WriterT@, we define a newtype for
+-- better error messages.
+newtype GWidget sub master a = GWidget
+    { unGWidget :: GHandler sub master (a, GWData (Route master))
+    }
+
+instance (a ~ ()) => Monoid (GWidget sub master a) where
+    mempty = return ()
+    mappend x y = x >> y
+
+type RY master = Route master -> [(Text, Text)] -> Text
+
+-- | Newtype wrapper allowing injection of arbitrary content into CSS.
+--
+-- Usage:
+--
+-- > toWidget $ CssBuilder "p { color: red }"
+--
+-- Since: 1.1.3
+newtype CssBuilder = CssBuilder { unCssBuilder :: TBuilder.Builder }
+
+-- | Content for a web page. By providing this datatype, we can easily create
+-- generic site templates, which would have the type signature:
+--
+-- > PageContent url -> HtmlUrl url
+data PageContent url = PageContent
+    { pageTitle :: Html
+    , pageHead  :: HtmlUrl url
+    , pageBody  :: HtmlUrl url
+    }
+
+data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content and optional content length.
+             | ContentSource !(Source (ResourceT IO) (Flush BBuilder.Builder))
+             | ContentFile !FilePath !(Maybe FilePart)
+             | ContentDontEvaluate !Content
+
+-- | A function which gives targetted representations of content based on the
+-- content-types the user accepts.
+type ChooseRep =
+    [ContentType] -- ^ list of content-types user accepts, ordered by preference
+ -> IO (ContentType, Content)
+
+newtype RepHtml = RepHtml Content
+newtype RepJson = RepJson Content
+data RepHtmlJson = RepHtmlJson Content Content
+newtype RepPlain = RepPlain Content
+newtype RepXml = RepXml Content
+
+type ContentType = ByteString -- FIXME Text?
+
+-- | Prevents a response body from being fully evaluated before sending the
+-- request.
+--
+-- Since 1.1.0
+newtype DontFullyEvaluate a = DontFullyEvaluate a
+
+-- | Responses to indicate some form of an error occurred. These are different
+-- from 'SpecialResponse' in that they allow for custom error pages.
+data ErrorResponse =
+      NotFound
+    | InternalError Text
+    | InvalidArgs [Text]
+    | PermissionDenied Text
+    | BadMethod H.Method
+    deriving (Show, Eq, Typeable)
+
+----- header stuff
+-- | Headers to be added to a 'Result'.
+data Header =
+    AddCookie SetCookie
+    | DeleteCookie ByteString ByteString
+    | Header ByteString ByteString
+    deriving (Eq, Show)
+
+data Location url = Local url | Remote Text
+    deriving (Show, Eq)
+
+newtype UniqueList x = UniqueList ([x] -> [x])
+
+data Script url = Script { scriptLocation :: Location url, scriptAttributes :: [(Text, Text)] }
+    deriving (Show, Eq)
+data Stylesheet url = Stylesheet { styleLocation :: Location url, styleAttributes :: [(Text, Text)] }
+    deriving (Show, Eq)
+newtype Title = Title { unTitle :: Html }
+
+newtype Head url = Head (HtmlUrl url)
+    deriving Monoid
+newtype Body url = Body (HtmlUrl url)
+    deriving Monoid
+
+type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder
+
+data GWData a = GWData
+    { gwdBody        :: !(Body a)
+    , gwdTitle       :: !(Last Title)
+    , gwdScripts     :: !(UniqueList (Script a))
+    , gwdStylesheets :: !(UniqueList (Stylesheet a))
+    , gwdCss         :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
+    , gwdJavascript  :: !(Maybe (JavascriptUrl a))
+    , gwdHead        :: !(Head a)
+    }
+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)
+        (unionWith mappend a5 b5)
+        (a6 `mappend` b6)
+        (a7 `mappend` b7)
+
+data HandlerContents =
+      HCContent H.Status ChooseRep
+    | HCError ErrorResponse
+    | HCSendFile ContentType FilePath (Maybe FilePart)
+    | HCRedirect H.Status Text
+    | HCCreated Text
+    | HCWai W.Response
+    deriving Typeable
+
+instance Show HandlerContents where
+    show _ = "Cannot show a HandlerContents"
+instance Exception HandlerContents
+
+-- Instances for GWidget
+instance Functor (GWidget sub master) where
+    fmap f (GWidget x) = GWidget (fmap (first f) x)
+instance Applicative (GWidget sub master) where
+    pure a = GWidget $ pure (a, mempty)
+    GWidget f <*> GWidget v =
+        GWidget $ k <$> f <*> v
+      where
+        k (a, wa) (b, wb) = (a b, wa `mappend` wb)
+instance Monad (GWidget sub master) where
+    return = pure
+    GWidget x >>= f = GWidget $ do
+        (a, wa) <- x
+        (b, wb) <- unGWidget (f a)
+        return (b, wa `mappend` wb)
+instance MonadIO (GWidget sub master) where
+    liftIO = GWidget . fmap (\a -> (a, mempty)) . liftIO
+instance MonadBase IO (GWidget sub master) where
+    liftBase = GWidget . fmap (\a -> (a, mempty)) . liftBase
+instance MonadBaseControl IO (GWidget sub master) where
+    data StM (GWidget sub master) a =
+        StW (StM (GHandler sub master) (a, GWData (Route master)))
+    liftBaseWith f = GWidget $ liftBaseWith $ \runInBase ->
+        liftM (\x -> (x, mempty))
+        (f $ liftM StW . runInBase . unGWidget)
+    restoreM (StW base) = GWidget $ restoreM base
+
+instance MonadUnsafeIO (GWidget sub master) where
+    unsafeLiftIO = liftIO
+instance MonadThrow (GWidget sub master) where
+    monadThrow = liftIO . throwIO
+instance MonadResource (GWidget sub master) where
+    liftResourceT = lift . liftResourceT
+
+instance MonadLogger (GWidget sub master) where
+    monadLoggerLog a b c = lift . monadLoggerLog a b c
+
+instance MonadLift (GHandler sub master) (GWidget sub master) where
+    lift = GWidget . fmap (\x -> (x, mempty))
+
+instance MonadLift (ResourceT IO) (GHandler sub master) where
+    lift = GHandler . const
+
+-- Instances for GHandler
+instance Functor (GHandler sub master) where
+    fmap f (GHandler x) = GHandler $ \r -> fmap f (x r)
+instance Applicative (GHandler sub master) where
+    pure = GHandler . const . pure
+    GHandler f <*> GHandler x = GHandler $ \r -> f r <*> x r
+instance Monad (GHandler sub master) where
+    return = pure
+    GHandler x >>= f = GHandler $ \r -> x r >>= \x' -> unGHandler (f x') r
+instance MonadIO (GHandler sub master) where
+    liftIO = GHandler . const . lift
+instance MonadBase IO (GHandler sub master) where
+    liftBase = GHandler . const . lift
+-- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s
+-- @fork@ function is incompatible with the underlying @ResourceT@ system.
+-- Instead, if you must fork a separate thread, you should use
+-- @resourceForkIO@.
+--
+-- Using fork usually leads to an exception that says
+-- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed
+-- after cleanup. Please contact the maintainers.\"
+instance MonadBaseControl IO (GHandler sub master) where
+    data StM (GHandler sub master) a = StH (StM (ResourceT IO) a)
+    liftBaseWith f = GHandler $ \reader ->
+        liftBaseWith $ \runInBase ->
+            f $ liftM StH . runInBase . (\(GHandler r) -> r reader)
+    restoreM (StH base) = GHandler $ const $ restoreM base
+
+instance MonadUnsafeIO (GHandler sub master) where
+    unsafeLiftIO = liftIO
+instance MonadThrow (GHandler sub master) where
+    monadThrow = liftIO . throwIO
+instance MonadResource (GHandler sub master) where
+    liftResourceT = lift . liftResourceT
+
+instance MonadLogger (GHandler sub master) where
+    monadLoggerLog a b c d = GHandler $ \hd ->
+        liftIO $ handlerLog hd a b c (toLogStr d)
+
+instance Exception e => Failure e (GHandler sub master) where
+    failure = liftIO . throwIO
+
+instance Monoid (UniqueList x) where
+    mempty = UniqueList id
+    UniqueList x `mappend` UniqueList y = UniqueList $ x . y
+
+instance IsString Content where
+    fromString = flip ContentBuilder Nothing . Blaze.ByteString.Builder.Char.Utf8.fromString
+
+instance RenderRoute WaiSubsite where
+    data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]
+        deriving (Show, Eq, Read, Ord)
+    renderRoute (WaiSubsiteRoute ps qs) = (ps, qs)

yesod-core/Yesod/Dispatch.hs

@@ -33,7 +33,6 @@ import Control.Applicative ((<$>), (<*>))
 import Prelude hiding (exp)
 import Yesod.Internal.Core
 import Yesod.Handler hiding (lift)
-import Yesod.Widget (GWidget)
 
 import Web.PathPieces
 import Language.Haskell.TH
@@ -56,8 +55,7 @@ import Yesod.Routes.TH
 import Yesod.Content (chooseRep)
 import Yesod.Routes.Parse
 import System.Log.FastLogger (Logger)
-
+import Yesod.Core.Types
-type Texts = [Text]
 
 -- | Generates URL datatype and site function for the given 'Resource's. This
 -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
@@ -210,14 +208,3 @@ sendRedirect y segments' env =
             then dest
             else (dest `mappend`
                  Blaze.ByteString.Builder.fromByteString (W.rawQueryString env))
-
--- | Wrap up a normal WAI application as a Yesod subsite.
-newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
-
-instance RenderRoute WaiSubsite where
-    data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]
-        deriving (Show, Eq, Read, Ord)
-    renderRoute (WaiSubsiteRoute ps qs) = (ps, qs)
-
-instance YesodDispatch WaiSubsite master where
-    yesodDispatch _logger _master (WaiSubsite app) _tomaster _404 _405 _method _pieces _session = app

yesod-core/Yesod/Handler.hs

@@ -129,11 +129,8 @@ import Control.Exception hiding (Handler, catch, finally)
 import Control.Applicative
 
 import Control.Monad (liftM)
-import Control.Failure (Failure (failure))
 
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Class (MonadTrans)
-import qualified Control.Monad.Trans.Class
 
 import System.IO
 import qualified Network.Wai as W
@@ -163,7 +160,7 @@ import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 import Blaze.ByteString.Builder (toByteString, toLazyByteString, fromLazyByteString)
 import Data.Text (Text)
-import Yesod.Message (RenderMessage (..))
+import Text.Shakespeare.I18N (RenderMessage (..))
 
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 #define preEscapedText preEscapedToMarkup
@@ -172,30 +169,18 @@ import System.Log.FastLogger
 import Control.Monad.Logger
 
 import qualified Yesod.Internal.Cache as Cache
-import Yesod.Internal.Cache (mkCacheKey, CacheKey)
+import Yesod.Internal.Cache (mkCacheKey)
 import qualified Data.IORef as I
 import Control.Exception.Lifted (catch)
-import Control.Monad.Trans.Control
 import Control.Monad.Trans.Resource
-import Control.Monad.Base
 import Yesod.Routes.Class
 import Language.Haskell.TH.Syntax (Loc)
+import Yesod.Core.Types
+import Yesod.Core.Trans.Class
 
 class YesodSubRoute s y where
     fromSubRoute :: s -> y -> Route s -> Route y
 
-data HandlerData sub master = HandlerData
-    { handlerRequest  :: Request
-    , handlerSub      :: sub
-    , handlerMaster   :: master
-    , handlerRoute    :: Maybe (Route sub)
-    , handlerRender   :: Route master -> [(Text, Text)] -> Text
-    , handlerToMaster :: Route sub -> Route master
-    , handlerState    :: I.IORef GHState
-    , handlerUpload   :: W.RequestBodyLength -> FileUpload
-    , handlerLog      :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
-    }
-
 handlerSubData :: (Route sub -> Route master)
                -> (master -> sub)
                -> Route sub
@@ -270,38 +255,6 @@ toMasterHandlerMaybe :: (Route sub -> Route master)
                      -> GHandler sub' master a
 toMasterHandlerMaybe tm ts route = local (handlerSubDataMaybe tm ts route)
 
--- | A generic handler monad, which can have a different subsite and master
--- site. We define a newtype for better error message.
-newtype GHandler sub master a = GHandler
-    { unGHandler :: HandlerData sub master -> ResourceT IO a
-    }
-
-data GHState = GHState
-    { ghsSession :: SessionMap
-    , ghsRBC :: Maybe RequestBodyContents
-    , ghsIdent :: Int
-    , ghsCache :: Cache.Cache
-    , ghsHeaders :: Endo [Header]
-    }
-
-type SessionMap = Map.Map Text S.ByteString
-
--- | An extension of the basic WAI 'W.Application' datatype to provide extra
--- features needed by Yesod. Users should never need to use this directly, as
--- the 'GHandler' monad and template haskell code should hide it away.
-newtype YesodApp = YesodApp
-    { unYesodApp
-    :: (ErrorResponse -> YesodApp)
-    -> Request
-    -> [ContentType]
-    -> SessionMap
-    -> ResourceT IO YesodAppResult
-    }
-
-data YesodAppResult
-    = YARWai W.Response
-    | YARPlain H.Status [Header] ContentType Content SessionMap
-
 getRequest :: GHandler s m Request
 getRequest = handlerRequest `liftM` ask
 
@@ -1003,71 +956,3 @@ local :: (HandlerData sub' master' -> HandlerData sub master)
       -> GHandler sub master a
       -> GHandler sub' master' a
 local f (GHandler x) = GHandler $ \r -> x $ f r
-
--- | The standard @MonadTrans@ class only allows lifting for monad
--- transformers. While @GHandler@ and @GWidget@ should allow lifting, their
--- types do not express that they actually are transformers. This replacement
--- class accounts for this.
-class MonadLift base m | m -> base where
-    lift :: base a -> m a
-instance (Monad m, MonadTrans t) => MonadLift m (t m) where
-    lift = Control.Monad.Trans.Class.lift
-instance MonadLift (ResourceT IO) (GHandler sub master) where
-    lift = GHandler . const
-
--- Instances for GHandler
-instance Functor (GHandler sub master) where
-    fmap f (GHandler x) = GHandler $ \r -> fmap f (x r)
-instance Applicative (GHandler sub master) where
-    pure = GHandler . const . pure
-    GHandler f <*> GHandler x = GHandler $ \r -> f r <*> x r
-instance Monad (GHandler sub master) where
-    return = pure
-    GHandler x >>= f = GHandler $ \r -> x r >>= \x' -> unGHandler (f x') r
-instance MonadIO (GHandler sub master) where
-    liftIO = GHandler . const . lift
-instance MonadBase IO (GHandler sub master) where
-    liftBase = GHandler . const . lift
--- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s
--- @fork@ function is incompatible with the underlying @ResourceT@ system.
--- Instead, if you must fork a separate thread, you should use
--- @resourceForkIO@.
---
--- Using fork usually leads to an exception that says
--- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed
--- after cleanup. Please contact the maintainers.\"
-instance MonadBaseControl IO (GHandler sub master) where
-    data StM (GHandler sub master) a = StH (StM (ResourceT IO) a)
-    liftBaseWith f = GHandler $ \reader ->
-        liftBaseWith $ \runInBase ->
-            f $ liftM StH . runInBase . (\(GHandler r) -> r reader)
-    restoreM (StH base) = GHandler $ const $ restoreM base
-
-instance MonadUnsafeIO (GHandler sub master) where
-    unsafeLiftIO = liftIO
-instance MonadThrow (GHandler sub master) where
-    monadThrow = liftIO . throwIO
-instance MonadResource (GHandler sub master) where
-#if MIN_VERSION_resourcet(0,4,0)
-    liftResourceT = lift . liftResourceT
-#else
-    allocate a = lift . allocate a
-    register = lift . register
-    release = lift . release
-    resourceMask = lift . resourceMask
-#endif
-
-instance MonadLogger (GHandler sub master) where
-#if MIN_VERSION_monad_logger(0, 3, 0)
-    monadLoggerLog a b c d = do
-        hd <- ask
-        liftIO $ handlerLog hd a b c (toLogStr d)
-#else
-    monadLoggerLog a c d = monadLoggerLogSource a "" c d
-    monadLoggerLogSource a b c d = do
-        hd <- ask
-        liftIO $ handlerLog hd a b c (toLogStr d)
-#endif
-
-instance Exception e => Failure e (GHandler sub master) where
-    failure = liftIO . throwIO

yesod-core/Yesod/Internal.hs

@@ -30,108 +30,24 @@ module Yesod.Internal
     , tokenKey
     ) where
 
-import Text.Hamlet (HtmlUrl, Html)
+import Text.Hamlet (HtmlUrl)
 import Text.Blaze.Html (toHtml)
-import Text.Julius (JavascriptUrl)
-import Data.Monoid (Monoid (..), Last)
 import Data.List (nub)
 
-import Data.Text (Text)
-
-import Data.Typeable (Typeable)
-import Control.Exception (Exception)
-
-import qualified Network.HTTP.Types as H
 import Data.String (IsString)
-import qualified Data.Map as Map
+import Yesod.Core.Types
-import Data.Text.Lazy.Builder (Builder)
-import Web.Cookie (SetCookie (..))
-import Data.ByteString (ByteString)
-import qualified Network.Wai as W
-import Yesod.Content (ChooseRep, ContentType)
-
--- | Responses to indicate some form of an error occurred. These are different
--- from 'SpecialResponse' in that they allow for custom error pages.
-data ErrorResponse =
-      NotFound
-    | InternalError Text
-    | InvalidArgs [Text]
-    | PermissionDenied Text
-    | BadMethod H.Method
-    deriving (Show, Eq, Typeable)
-
------ header stuff
--- | Headers to be added to a 'Result'.
-data Header =
-    AddCookie SetCookie
-    | DeleteCookie ByteString ByteString
-    | Header ByteString ByteString
-    deriving (Eq, Show)
 
 langKey :: IsString a => a
 langKey = "_LANG"
 
-data Location url = Local url | Remote Text
-    deriving (Show, Eq)
 locationToHtmlUrl :: Location url -> HtmlUrl url
 locationToHtmlUrl (Local url) render = toHtml $ render url []
 locationToHtmlUrl (Remote s) _ = toHtml s
 
-newtype UniqueList x = UniqueList ([x] -> [x])
-instance Monoid (UniqueList x) where
-    mempty = UniqueList id
-    UniqueList x `mappend` UniqueList y = UniqueList $ x . y
 runUniqueList :: Eq x => UniqueList x -> [x]
 runUniqueList (UniqueList x) = nub $ x []
 toUnique :: x -> UniqueList x
 toUnique = UniqueList . (:)
 
-data Script url = Script { scriptLocation :: Location url, scriptAttributes :: [(Text, Text)] }
-    deriving (Show, Eq)
-data Stylesheet url = Stylesheet { styleLocation :: Location url, styleAttributes :: [(Text, Text)] }
-    deriving (Show, Eq)
-newtype Title = Title { unTitle :: Html }
-
-newtype Head url = Head (HtmlUrl url)
-    deriving Monoid
-newtype Body url = Body (HtmlUrl url)
-    deriving Monoid
-
 tokenKey :: IsString a => a
 tokenKey = "_TOKEN"
-
-type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> Builder
-
-data GWData a = GWData
-    { gwdBody :: !(Body a)
-    , gwdTitle :: !(Last Title)
-    , gwdScripts :: !(UniqueList (Script a))
-    , gwdStylesheets :: !(UniqueList (Stylesheet a))
-    , gwdCss :: !(Map.Map (Maybe Text) (CssBuilderUrl a)) -- media type
-    , gwdJavascript :: !(Maybe (JavascriptUrl a))
-    , gwdHead :: !(Head a)
-    }
-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)
-        (Map.unionWith mappend a5 b5)
-        (a6 `mappend` b6)
-        (a7 `mappend` b7)
-
-data HandlerContents =
-      HCContent H.Status ChooseRep
-    | HCError ErrorResponse
-    | HCSendFile ContentType FilePath (Maybe W.FilePart)
-    | HCRedirect H.Status Text
-    | HCCreated Text
-    | HCWai W.Response
-    deriving Typeable
-
-instance Show HandlerContents where
-    show _ = "Cannot show a HandlerContents"
-instance Exception HandlerContents

yesod-core/Yesod/Internal/Cache.hs

@@ -14,15 +14,9 @@ import qualified Data.IntMap as Map
 import Language.Haskell.TH.Syntax (Q, Exp, runIO, Exp (LitE), Lit (IntegerL))
 import Language.Haskell.TH (appE)
 import Data.Unique (hashUnique, newUnique)
-import GHC.Exts (Any)
 import Unsafe.Coerce (unsafeCoerce)
-import Data.Monoid (Monoid)
 import Control.Applicative ((<$>))
-
+import Yesod.Core.Types
-newtype Cache = Cache (Map.IntMap Any)
-    deriving Monoid
-
-newtype CacheKey a = CacheKey Int
 
 -- | Generate a new 'CacheKey'. Be sure to give a full type signature.
 mkCacheKey :: Q Exp

yesod-core/Yesod/Internal/Core.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE FlexibleInstances #-}
 -- | The basic typeclass for a Yesod application.
 module Yesod.Internal.Core
     ( -- * Type classes
@@ -95,6 +96,7 @@ import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerP
 import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource)
 import System.Log.FastLogger.Date (ZonedDate)
 import System.IO (stdout)
+import Yesod.Core.Types
 
 yesodVersion :: String
 yesodVersion = showVersion Paths_yesod_core.version
@@ -126,18 +128,6 @@ class YesodDispatch sub master where
                 -> W.Application
     yesodRunner = defaultYesodRunner
 
--- | How to determine the root of the application for constructing URLs.
---
--- Note that future versions of Yesod may add new constructors without bumping
--- the major version number. As a result, you should /not/ pattern match on
--- @Approot@ values.
-data Approot master = ApprootRelative -- ^ No application root.
-                    | ApprootStatic Text
-                    | ApprootMaster (master -> Text)
-                    | ApprootRequest (master -> W.Request -> Text)
-
-type ResolvedApproot = Text
-
 -- | Define settings for a Yesod applications. All methods have intelligent
 -- defaults, and therefore no implementation is required.
 class RenderRoute a => Yesod a where
@@ -472,9 +462,6 @@ defaultYesodRunner logger handler' master sub murl toMasterRoute msb req
     maxLen = maximumContentLength master $ fmap toMasterRoute murl
     handler = yesodMiddleware handler'
 
-data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
-    deriving (Eq, Show, Read)
-
 -- | A type-safe, concise method of creating breadcrumbs for pages. For each
 -- resource, you declare the title of the page and the parent resource (if
 -- present).
@@ -664,16 +651,6 @@ $newline never
             : attrs
             )
 
-data ScriptLoadPosition master
-    = BottomOfBody
-    | BottomOfHeadBlocking
-    | BottomOfHeadAsync (BottomOfHeadAsync master)
-
-type BottomOfHeadAsync master
-       = [Text] -- ^ urls to load asynchronously
-      -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion
-      -> (HtmlUrl (Route master)) -- ^ widget to insert at the bottom of <head>
-
 left :: Either a b -> Maybe a
 left (Left x) = Just x
 left _ = Nothing
@@ -874,3 +851,6 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
   _ <- runResourceT $ yapp errHandler fakeRequest fakeContentType fakeSessionMap
   I.readIORef ret
 {-# WARNING runFakeHandler "Usually you should *not* use runFakeHandler unless you really understand how it works and why you need it." #-}
+
+instance YesodDispatch WaiSubsite master where
+    yesodDispatch _logger _master (WaiSubsite app) _tomaster _404 _405 _method _pieces _session = app

yesod-core/Yesod/Internal/Request.hs

@@ -43,17 +43,7 @@ import Data.Conduit.Binary (sourceFile, sinkFile)
 import Data.Word (Word64)
 import Control.Monad.IO.Class (liftIO)
 import Control.Exception (throwIO)
-
+import Yesod.Core.Types
--- | The parsed request information.
-data Request = Request
-    { reqGetParams :: [(Text, Text)]
-    , reqCookies :: [(Text, Text)]
-    , reqWaiRequest :: W.Request
-      -- | Languages which the client supports.
-    , reqLangs :: [Text]
-      -- | A random, session-specific token used to prevent CSRF attacks.
-    , reqToken :: Maybe Text
-    }
 
 parseWaiRequest :: W.Request
                 -> [(Text, ByteString)] -- ^ session
@@ -149,19 +139,6 @@ randomString len = take len . map toChar . randomRs (0, 61)
         | i < 52 = toEnum $ i + fromEnum 'a' - 26
         | otherwise = toEnum $ i + fromEnum '0' - 52
 
--- | A tuple containing both the POST parameters and submitted files.
-type RequestBodyContents =
-    ( [(Text, Text)]
-    , [(Text, FileInfo)]
-    )
-
-data FileInfo = FileInfo
-    { fileName :: Text
-    , fileContentType :: Text
-    , fileSource :: Source (ResourceT IO) ByteString
-    , fileMove :: FilePath -> IO ()
-    }
-
 mkFileInfoLBS :: Text -> Text -> L.ByteString -> FileInfo
 mkFileInfoLBS name ct lbs = FileInfo name ct (sourceList $ L.toChunks lbs) (\fp -> L.writeFile fp lbs)
 
@@ -170,7 +147,3 @@ mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runResourc
 
 mkFileInfoSource :: Text -> Text -> Source (ResourceT IO) ByteString -> FileInfo
 mkFileInfoSource name ct src = FileInfo name ct src (\dst -> runResourceT $ src $$ sinkFile dst)
-
-data FileUpload = FileUploadMemory (NWP.BackEnd L.ByteString)
-                | FileUploadDisk (NWP.BackEnd FilePath)
-                | FileUploadSource (NWP.BackEnd (Source (ResourceT IO) ByteString))

yesod-core/Yesod/Internal/Session.hs

@@ -8,32 +8,16 @@ module Yesod.Internal.Session
     , SessionBackend(..)
     ) where
 
-import Yesod.Internal (Header(..))
 import qualified Web.ClientSession as CS
-import Data.Int (Int64)
 import Data.Serialize
 import Data.Time
 import Data.ByteString (ByteString)
 import Control.Concurrent (forkIO, killThread, threadDelay)
 import Control.Monad (forever, guard)
-import Data.Text (Text, pack, unpack)
+import Data.Text (Text)
-import Control.Arrow (first)
+import Yesod.Core.Types
-import Control.Applicative ((<$>))
+import Yesod.Core.Time
-
-import qualified Data.ByteString.Char8 as S8
 import qualified Data.IORef as I
-import qualified Network.Wai as W
-
-type BackendSession = [(Text, S8.ByteString)]
-
-type SaveSession = BackendSession    -- ^ The session contents after running the handler
-                -> IO [Header]
-
-newtype SessionBackend master = SessionBackend
-    { sbLoadSession :: master
-                    -> W.Request
-                    -> IO (BackendSession, SaveSession) -- ^ Return the session data and a function to save the session
-    }
 
 encodeClientSession :: CS.Key
                     -> CS.IV
@@ -58,19 +42,6 @@ decodeClientSession key date rhost encrypted = do
     guard $ rhost' == rhost
     return session'
 
-data SessionCookie = SessionCookie (Either UTCTime ByteString) ByteString [(Text, ByteString)]
-    deriving (Show, Read)
-instance Serialize SessionCookie where
-    put (SessionCookie a b c) = do
-        either putTime putByteString a
-        put b
-        put (map (first unpack) c)
-    get = do
-        a <- getTime
-        b <- get
-        c <- map (first pack) <$> get
-        return $ SessionCookie (Left a) b c
-
 
 ----------------------------------------------------------------------
 
@@ -81,13 +52,6 @@ instance Serialize SessionCookie where
 -- The cached date is updated every 10s, we don't need second
 -- resolution for session expiration times.
 
-data ClientSessionDateCache =
-  ClientSessionDateCache {
-    csdcNow               :: !UTCTime
-  , csdcExpires           :: !UTCTime
-  , csdcExpiresSerialized :: !ByteString
-  } deriving (Eq, Show)
-
 clientSessionDateCacher ::
      NominalDiffTime -- ^ Inactive session valitity.
   -> IO (IO ClientSessionDateCache, IO ())
@@ -104,27 +68,3 @@ clientSessionDateCacher validity = do
     doUpdate ref = do
       threadDelay 10000000 -- 10s
       I.writeIORef ref =<< getUpdated
-
-
-----------------------------------------------------------------------
-
-
-putTime :: Putter UTCTime
-putTime (UTCTime d t) =
-  let d' = fromInteger  $ toModifiedJulianDay d
-      t' = fromIntegral $ fromEnum (t / diffTimeScale)
-  in put (d' * posixDayLength_int64 + min posixDayLength_int64 t')
-
-getTime :: Get UTCTime
-getTime = do
-  val <- get
-  let (d, t) = val `divMod` posixDayLength_int64
-      d' = ModifiedJulianDay $! fromIntegral d
-      t' = fromIntegral t
-  d' `seq` t' `seq` return (UTCTime d' t')
-
-posixDayLength_int64 :: Int64
-posixDayLength_int64 = 86400
-
-diffTimeScale :: DiffTime
-diffTimeScale = 1e12

yesod-core/Yesod/Message.hs

@@ -1,6 +0,0 @@
--- | This module has moved to "Text.Shakespeare.I18N"
-module Yesod.Message
-    ( module Text.Shakespeare.I18N
-    ) where
-
-import Text.Shakespeare.I18N

yesod-core/Yesod/Widget.hs

@@ -52,13 +52,11 @@ import Text.Cassius
 import Text.Julius
 import Yesod.Routes.Class
 import Yesod.Handler
-    ( GHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod
+    ( YesodSubRoute(..), toMasterHandlerMaybe, getYesod
     , getMessageRender, getUrlRenderParams, MonadLift (..)
     )
-import Yesod.Message (RenderMessage)
+import Text.Shakespeare.I18N (RenderMessage)
-import Yesod.Content (RepHtml (..), toContent)
+import Yesod.Content (toContent)
-import Control.Applicative (Applicative (..), (<$>))
-import Control.Monad.IO.Class (MonadIO (liftIO))
 import Yesod.Internal
 import Control.Monad (liftM)
 import Data.Text (Text)
@@ -66,32 +64,16 @@ import qualified Data.Map as Map
 import Language.Haskell.TH.Quote (QuasiQuoter)
 import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE, AppE), Pat (VarP), newName)
 
-import Control.Monad.Trans.Control (MonadBaseControl (..))
-import Control.Exception (throwIO)
 import qualified Text.Hamlet as NP
-import Data.Text.Lazy.Builder (fromLazyText, Builder)
+import Data.Text.Lazy.Builder (fromLazyText)
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 import qualified Data.Text.Lazy as TL
-import Control.Monad.Base (MonadBase (liftBase))
-import Control.Arrow (first)
-import Control.Monad.Trans.Resource
 
-import Control.Monad.Logger
+import Yesod.Core.Types
 
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 
--- | A generic widget, allowing specification of both the subsite and master
--- site datatypes. While this is simply a @WriterT@, we define a newtype for
--- better error messages.
-newtype GWidget sub master a = GWidget
-    { unGWidget :: GHandler sub master (a, GWData (Route master))
-    }
-
-instance (a ~ ()) => Monoid (GWidget sub master a) where
-    mempty = return ()
-    mappend x y = x >> y
-
 addSubWidget :: (YesodSubRoute sub master) => sub -> GWidget sub master a -> GWidget sub' master a
 addSubWidget sub (GWidget w) = do
     master <- lift getYesod
@@ -103,17 +85,6 @@ addSubWidget sub (GWidget w) = do
 class ToWidget sub master a where
     toWidget :: a -> GWidget sub master ()
 
-type RY master = Route master -> [(Text, Text)] -> Text
-
--- | Newtype wrapper allowing injection of arbitrary content into CSS.
---
--- Usage:
---
--- > toWidget $ CssBuilder "p { color: red }"
---
--- Since: 1.1.3
-newtype CssBuilder = CssBuilder { unCssBuilder :: Builder }
-
 instance render ~ RY master => ToWidget sub master (render -> Html) where
     toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
 instance render ~ RY master => ToWidget sub master (render -> Css) where
@@ -216,16 +187,6 @@ addScriptRemote = flip addScriptRemoteAttrs []
 addScriptRemoteAttrs :: Text -> [(Text, Text)] -> GWidget sub master ()
 addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
 
--- | Content for a web page. By providing this datatype, we can easily create
--- generic site templates, which would have the type signature:
---
--- > PageContent url -> HtmlUrl url
-data PageContent url = PageContent
-    { pageTitle :: Html
-    , pageHead :: HtmlUrl url
-    , pageBody :: HtmlUrl url
-    }
-
 whamlet :: QuasiQuoter
 whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
 
@@ -264,58 +225,6 @@ ihamletToRepHtml ih = do
 tell :: GWData (Route master) -> GWidget sub master ()
 tell w = GWidget $ return ((), w)
 
-instance MonadLift (GHandler sub master) (GWidget sub master) where
-    lift = GWidget . fmap (\x -> (x, mempty))
-
 -- | Type-restricted version of @lift@
 liftW :: GHandler sub master a -> GWidget sub master a
 liftW = lift
-
--- Instances for GWidget
-instance Functor (GWidget sub master) where
-    fmap f (GWidget x) = GWidget (fmap (first f) x)
-instance Applicative (GWidget sub master) where
-    pure a = GWidget $ pure (a, mempty)
-    GWidget f <*> GWidget v =
-        GWidget $ k <$> f <*> v
-      where
-        k (a, wa) (b, wb) = (a b, wa `mappend` wb)
-instance Monad (GWidget sub master) where
-    return = pure
-    GWidget x >>= f = GWidget $ do
-        (a, wa) <- x
-        (b, wb) <- unGWidget (f a)
-        return (b, wa `mappend` wb)
-instance MonadIO (GWidget sub master) where
-    liftIO = GWidget . fmap (\a -> (a, mempty)) . liftIO
-instance MonadBase IO (GWidget sub master) where
-    liftBase = GWidget . fmap (\a -> (a, mempty)) . liftBase
-instance MonadBaseControl IO (GWidget sub master) where
-    data StM (GWidget sub master) a =
-        StW (StM (GHandler sub master) (a, GWData (Route master)))
-    liftBaseWith f = GWidget $ liftBaseWith $ \runInBase ->
-        liftM (\x -> (x, mempty))
-        (f $ liftM StW . runInBase . unGWidget)
-    restoreM (StW base) = GWidget $ restoreM base
-
-instance MonadUnsafeIO (GWidget sub master) where
-    unsafeLiftIO = liftIO
-instance MonadThrow (GWidget sub master) where
-    monadThrow = liftIO . throwIO
-instance MonadResource (GWidget sub master) where
-#if MIN_VERSION_resourcet(0,4,0)
-    liftResourceT = lift . liftResourceT
-#else
-    allocate a = lift . allocate a
-    register = lift . register
-    release = lift . release
-    resourceMask = lift . resourceMask
-#endif
-
-instance MonadLogger (GWidget sub master) where
-#if MIN_VERSION_monad_logger(0, 3, 0)
-    monadLoggerLog a b c = lift . monadLoggerLog a b c
-#else
-    monadLoggerLog a b = lift . monadLoggerLog a b
-    monadLoggerLogSource a b c = lift . monadLoggerLogSource a b c
-#endif

yesod-core/yesod-core.cabal

@@ -80,9 +80,9 @@ library
                    , vector                >= 0.9      && < 0.11
                    , aeson                 >= 0.5
                    , fast-logger           >= 0.2
-                   , monad-logger          >= 0.2.1    && < 0.4
+                   , monad-logger          >= 0.3      && < 0.4
                    , conduit               >= 0.5
-                   , resourcet             >= 0.3      && < 0.5
+                   , resourcet             >= 0.4      && < 0.5
                    , lifted-base           >= 0.1
                    , attoparsec-conduit
                    , blaze-html            >= 0.5
@@ -95,13 +95,15 @@ library
                      Yesod.Handler
                      Yesod.Request
                      Yesod.Widget
-                     Yesod.Message
                      Yesod.Internal.TestApi
     other-modules:   Yesod.Internal
                      Yesod.Internal.Cache
                      Yesod.Internal.Core
                      Yesod.Internal.Session
                      Yesod.Internal.Request
+                     Yesod.Core.Types
+                     Yesod.Core.Time
+                     Yesod.Core.Trans.Class
                      Paths_yesod_core
     ghc-options:     -Wall