module Yesod.Internal
(
ErrorResponse (..)
, HandlerContents (..)
, Header (..)
, langKey
, GWData (..)
, Location (..)
, UniqueList (..)
, Script (..)
, Stylesheet (..)
, Title (..)
, Head (..)
, Body (..)
, locationToHtmlUrl
, runUniqueList
, toUnique
, tokenKey
) where
import Text.Hamlet (HtmlUrl, Html)
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 Data.Text.Lazy.Builder (Builder)
import Web.Cookie (SetCookie (..))
import Data.ByteString (ByteString)
import qualified Network.Wai as W
import Yesod.Content (ChooseRep, ContentType)
data ErrorResponse =
NotFound
| InternalError Text
| InvalidArgs [Text]
| PermissionDenied Text
| BadMethod H.Method
deriving (Show, Eq, Typeable)
instance Exception ErrorResponse
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))
, 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