module Yesod.Internal
(
ErrorResponse (..)
, Header (..)
, langKey
, GWData (..)
, Location (..)
, UniqueList (..)
, Script (..)
, Stylesheet (..)
, Title (..)
, Head (..)
, Body (..)
, locationToHtmlUrl
, runUniqueList
, toUnique
, tokenKey
) where
import Text.Hamlet (HtmlUrl, hamlet, Html)
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 Network.HTTP.Types (Ascii)
import Web.Cookie (SetCookie (..))
data ErrorResponse =
NotFound
| InternalError Text
| InvalidArgs [Text]
| PermissionDenied Text
| BadMethod H.Method
deriving (Show, Eq, Typeable)
instance Exception ErrorResponse
data Header =
AddCookie SetCookie
| DeleteCookie Ascii Ascii
| Header Ascii Ascii
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) = [hamlet|\@{url}
|]
locationToHtmlUrl (Remote s) = [hamlet|\#{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
!(Body a)
!(Last Title)
!(UniqueList (Script a))
!(UniqueList (Stylesheet a))
!(Map.Map (Maybe Text) (CssBuilderUrl a))
!(Maybe (JavascriptUrl a))
!(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)