packages feed

happstack-hsp 7.1.2 → 7.2.0

raw patch · 8 files changed

+104/−327 lines, 8 filesdep −hsxdep ~hsp

Dependencies removed: hsx

Dependency ranges changed: hsp

Files

happstack-hsp.cabal view
@@ -1,5 +1,5 @@ Name:                happstack-hsp-Version:             7.1.2+Version:             7.2.0 Synopsis:            Support for using HSP templates in Happstack Description:         Happstack is a web application framework. HSP is an XML templating solution. This package makes it easy to use HSP templates with Happstack. Homepage:            http://www.happstack.com/@@ -21,9 +21,9 @@   Hs-source-dirs:      src    Exposed-modules:     Happstack.Server.HSP.HTML-                       Happstack.Server.HSX-                       HSP.Identity-                       HSP.IdentityT+                       Happstack.Server.XMLGenT+--                       HSP.Identity+--                       HSP.IdentityT                        HSP.ServerPartT                        HSP.Google.Analytics @@ -31,10 +31,10 @@                        bytestring       >= 0.9 && < 0.11,                        happstack-server >= 6.0 && < 7.2,                        harp             >= 0.4 && < 0.5,-                       hsx              >= 0.10.2 && < 0.11,-                       hsp              >= 0.7.1 && < 0.8,+                       hsp              >= 0.9 && < 0.10,                        mtl              >= 1.1 && < 2.2,                        utf8-string      == 0.3.*,                        syb              >= 0.3 && < 0.5,                        text             >= 0.10 && < 0.12 +--  Build-tools:         hsx2hs
src/HSP/Google/Analytics.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleContexts, TypeFamilies #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleContexts, TypeFamilies, OverloadedStrings #-}+{-# OPTIONS_GHC -F -pgmFhsx2hs #-} module HSP.Google.Analytics     ( UACCT(..)     , analytics@@ -8,6 +8,7 @@     ) where  import Data.Generics (Data, Typeable)+import Data.Text.Lazy (Text) import HSP import Prelude hiding (head) @@ -17,7 +18,7 @@ -- | create the google analytics asynchronous tracking script tag -- -- NOTE: you must put this right before the \<\/head\> tag-analyticsAsync :: (XMLGenerator m) =>+analyticsAsync :: (XMLGenerator m, StringType m ~ Text) =>                   UACCT     -- ^ web property ID (looks like: @UA-XXXXX-X@)                -> GenXML m analyticsAsync (UACCT uacct) =@@ -42,7 +43,7 @@ -- You probably want to use 'analyticsAsync' instead. -- -- See also: 'addAnalytics', 'analyticsAsync'-analytics :: (XMLGenerator m) => UACCT -> GenXMLList m+analytics :: (XMLGenerator m, StringType m ~ Text) => UACCT -> GenXMLList m analytics (UACCT uacct) =     do a <- <script type="text/javascript">               var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");@@ -61,7 +62,9 @@                 , EmbedAsChild m XML                 , EmbedAsAttr m Attribute                 , XMLGenerator m-                , XMLType m ~ XML)+                , XMLType m ~ XML+                , StringType m ~ Text+                )              => UACCT              -> XMLGenT m XML              -> GenXML m
− src/HSP/Identity.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module HSP.Identity-    ( Ident-    , evalIdentity-    ) where--import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import HSP-import Control.Monad.Identity (Identity(Identity, runIdentity))-import HSX.XMLGenerator--instance XMLGenerator Identity--instance XMLGen Identity where-    type XMLType Identity = XML-    newtype ChildType Identity = IChild { unIChild :: XML }-    newtype AttributeType Identity = IAttr { unIAttr :: Attribute }-    genElement n attrs children = do-                           attrs'    <- asAttr attrs-                           children' <- asChild children-                           return $ Element (toName n) (map unIAttr attrs') (map unIChild children')-    xmlToChild = IChild-    pcdataToChild = xmlToChild . pcdata--instance IsAttrValue Identity T.Text where-    toAttrValue = toAttrValue . T.unpack--instance IsAttrValue Identity TL.Text where-    toAttrValue = toAttrValue . TL.unpack--instance EmbedAsAttr Identity Attribute where-    asAttr = return . (:[]) . IAttr--instance EmbedAsAttr Identity (Attr String Char) where-    asAttr (n := c)  = asAttr (n := [c])--instance EmbedAsAttr Identity (Attr String String) where-    asAttr (n := str)  = asAttr $ MkAttr (toName n, pAttrVal str)--instance EmbedAsAttr Identity (Attr String Bool) where-    asAttr (n := True)  = asAttr $ MkAttr (toName n, pAttrVal "true")-    asAttr (n := False) = asAttr $ MkAttr (toName n, pAttrVal "false")--instance EmbedAsAttr Identity (Attr String Int) where-    asAttr (n := i)  = asAttr $ MkAttr (toName n, pAttrVal (show i))--instance (IsName n) => (EmbedAsAttr Identity (Attr n TL.Text)) where-    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ TL.unpack a)--instance (IsName n) => (EmbedAsAttr Identity (Attr n T.Text)) where-    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ T.unpack a)--instance EmbedAsChild Identity Char where-    asChild = XMLGenT . Identity . (:[]) . IChild . pcdata . (:[])--instance EmbedAsChild Identity String where-    asChild = XMLGenT . Identity . (:[]) . IChild . pcdata--instance (EmbedAsChild Identity TL.Text) where-    asChild = asChild . TL.unpack--instance (EmbedAsChild Identity T.Text) where-    asChild = asChild . T.unpack--instance EmbedAsChild Identity XML where-    asChild = XMLGenT . Identity . (:[]) . IChild--instance EmbedAsChild Identity () where-  asChild () = return []--instance AppendChild Identity XML where- appAll xml children = do-        chs <- children-        case xml of-         CDATA _ _       -> return xml-         Element n as cs -> return $ Element n as (cs ++ (map stripChild chs))--stripAttr :: AttributeType Identity -> Attribute-stripAttr  (IAttr a) = a--stripChild :: ChildType Identity -> XML-stripChild (IChild c) = c--instance SetAttr Identity XML where- setAll xml hats = do-        attrs <- hats-        case xml of-         CDATA _ _       -> return xml-         Element n as cs -> return $ Element n (foldr insert as (map stripAttr attrs)) cs--insert :: Attribute -> Attributes -> Attributes-insert = (:)--evalIdentity :: XMLGenT Identity XML -> XML-evalIdentity = runIdentity . unXMLGenT--type Ident = XMLGenT Identity
− src/HSP/IdentityT.hs 
@@ -1,125 +0,0 @@-{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans -F -pgmF trhsx #-}-module HSP.IdentityT-    ( evalIdentityT-    , IdentT-    , IdentityT(..)-    ) where--import Control.Applicative  (Applicative((<*>), pure))-import Control.Monad        (MonadPlus)-import Control.Monad.Writer (MonadWriter)-import Control.Monad.Reader (MonadReader)-import Control.Monad.State  (MonadState)-import Control.Monad.RWS    (MonadRWS)-import Control.Monad.Trans  (MonadTrans(lift), MonadIO(liftIO))-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import HSP-import HSX.XMLGenerator---- * IdentityT Monad Transformer--newtype IdentityT m a = IdentityT { runIdentityT :: m a }-    deriving (Functor, Monad, MonadWriter w, MonadReader r, MonadState s, MonadRWS r w s, MonadIO, MonadPlus)--instance (Applicative f) => Applicative (IdentityT f) where-    pure  = IdentityT . pure-    (IdentityT f) <*> (IdentityT a) = IdentityT (f <*> a)--instance MonadTrans IdentityT where-    lift = IdentityT---- * HSX.XMLGenerator for IdentityT--instance (Monad m, Functor m) => XMLGenerator (IdentityT m)--instance (Functor m, Monad m) => XMLGen (IdentityT m) where-    type XMLType (IdentityT m) = XML-    newtype ChildType (IdentityT m) = IChild { unIChild :: XML }-    newtype AttributeType (IdentityT m) = IAttr { unIAttr :: Attribute }-    genElement n attrs children =-                                  do attrs'    <- fmap (map unIAttr . concat) (sequence attrs)-                                     children' <- fmap (map unIChild . concat) (sequence children)-                                     return (Element (toName n) attrs' children')-    xmlToChild = IChild-    pcdataToChild = xmlToChild . pcdata--instance (Monad m, Functor m) => IsAttrValue (IdentityT m) T.Text where-    toAttrValue = toAttrValue . T.unpack--instance (Monad m, Functor m) => IsAttrValue (IdentityT m) TL.Text where-    toAttrValue = toAttrValue . TL.unpack--instance (Monad m, Functor m) => EmbedAsAttr (IdentityT m) Attribute where-    asAttr = return . (:[]) . IAttr--instance (Monad m, Functor m) => EmbedAsAttr (IdentityT m) (Attr String Char) where-    asAttr (n := c)  = asAttr (n := [c])--instance (Monad m, Functor m) => EmbedAsAttr (IdentityT m) (Attr String String) where-    asAttr (n := str)  = asAttr $ MkAttr (toName n, pAttrVal str)--instance (Monad m, Functor m) => EmbedAsAttr (IdentityT m) (Attr String Bool) where-    asAttr (n := True)  = asAttr $ MkAttr (toName n, pAttrVal "true")-    asAttr (n := False) = asAttr $ MkAttr (toName n, pAttrVal "false")--instance (Monad m, Functor m) => EmbedAsAttr (IdentityT m) (Attr String Int) where-    asAttr (n := i)  = asAttr $ MkAttr (toName n, pAttrVal (show i))--instance (Monad m, Functor m, IsName n) => (EmbedAsAttr (IdentityT m) (Attr n TL.Text)) where-    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ TL.unpack a)--instance (Monad m, Functor m, IsName n) => (EmbedAsAttr (IdentityT m) (Attr n T.Text)) where-    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ T.unpack a)--instance (Monad m, Functor m) => EmbedAsChild (IdentityT m) Char where-    asChild = XMLGenT . return . (:[]) . IChild . pcdata . (:[])--instance (Monad m, Functor m) => EmbedAsChild (IdentityT m) String where-    asChild = XMLGenT . return . (:[]) . IChild . pcdata--instance (Monad m, Functor m) => EmbedAsChild (IdentityT m) (IdentityT m String) where-    asChild c =-        do c' <- lift c-           lift . return . (:[]) . IChild . pcdata $ c'--instance (Monad m, Functor m) => (EmbedAsChild (IdentityT m) TL.Text) where-    asChild = asChild . TL.unpack--instance (Monad m, Functor m) => (EmbedAsChild (IdentityT m) T.Text) where-    asChild = asChild . T.unpack--instance (Monad m, Functor m) => EmbedAsChild (IdentityT m) XML where-    asChild = XMLGenT . return . (:[]) . IChild--instance (Monad m, Functor m) => EmbedAsChild (IdentityT m) () where-  asChild () = return []--instance (Monad m, Functor m) => AppendChild (IdentityT m) XML where- appAll xml children = do-        chs <- children-        case xml of-         CDATA _ _       -> return xml-         Element n as cs -> return $ Element n as (cs ++ (map stripChild chs))--stripAttr :: (Monad m, Functor m) => AttributeType (IdentityT m) -> Attribute-stripAttr  (IAttr a) = a--stripChild :: (Monad m, Functor m) => ChildType (IdentityT m) -> XML-stripChild (IChild c) = c--instance (Monad m, Functor m) => SetAttr (IdentityT m) XML where- setAll xml hats = do-        attrs <- hats-        case xml of-         CDATA _ _       -> return xml-         Element n as cs -> return $ Element n (foldr insert as (map stripAttr attrs)) cs--insert :: Attribute -> Attributes -> Attributes-insert = (:)--evalIdentityT :: (Functor m, Monad m) => XMLGenT (IdentityT m) XML -> m XML-evalIdentityT = runIdentityT . unXMLGenT--type IdentT m = XMLGenT (IdentityT m) XML
src/HSP/ServerPartT.hs view
@@ -1,17 +1,19 @@ -- |This module provides, @instance 'XMLGenerator' ('ServerPartT' m)@-{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module HSP.ServerPartT () where -import HSP import Control.Monad              (liftM)+import Data.Monoid                ((<>)) import qualified Data.Text        as T import qualified Data.Text.Lazy   as TL-import HSX.XMLGenerator+import HSP.XML+import HSP.XMLGenerator import Happstack.Server (ServerPartT)  instance (Monad m) => XMLGen (ServerPartT m) where     type XMLType (ServerPartT m) = XML+    type StringType (ServerPartT m) = TL.Text     newtype ChildType (ServerPartT m) = SChild { unSChild :: XML }     newtype AttributeType (ServerPartT m) = SAttr { unSAttr :: Attribute }     genElement n attrs children =@@ -36,74 +38,74 @@         flP [] bs = reverse bs         flP [x] bs = reverse (x:bs)         flP (x:y:xs) bs = case (x,y) of-                           (CDATA e1 s1, CDATA e2 s2) | e1 == e2 -> flP (CDATA e1 (s1++s2) : xs) bs+                           (CDATA e1 s1, CDATA e2 s2) | e1 == e2 -> flP (CDATA e1 (s1<>s2) : xs) bs                            _ -> flP (y:xs) (x:bs) --instance (Monad m, Functor m) => IsAttrValue (ServerPartT m) T.Text where+{-+instance (Monad m) => IsAttrValue (ServerPartT m) T.Text where     toAttrValue = toAttrValue . T.unpack -instance (Monad m, Functor m) => IsAttrValue (ServerPartT m) TL.Text where+instance (Monad m) => IsAttrValue (ServerPartT m) TL.Text where     toAttrValue = toAttrValue . TL.unpack--instance (Monad m) => EmbedAsAttr (ServerPartT m) Attribute where+-}+instance (Functor m, Monad m) => EmbedAsAttr (ServerPartT m) Attribute where     asAttr = return . (:[]) . SAttr -instance (Monad m, IsName n) => EmbedAsAttr (ServerPartT m) (Attr n Char) where+instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n Char) where     asAttr (n := c)  = asAttr (n := [c]) -instance (Monad m, IsName n) => EmbedAsAttr (ServerPartT m) (Attr n String) where-    asAttr (n := str)  = asAttr $ MkAttr (toName n, pAttrVal str)+instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n String) where+    asAttr (n := str)  = asAttr $ MkAttr (toName n, pAttrVal $ TL.pack str) -instance (Monad m, IsName n) => EmbedAsAttr (ServerPartT m) (Attr n Bool) where+instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n Bool) where     asAttr (n := True)  = asAttr $ MkAttr (toName n, pAttrVal "true")     asAttr (n := False) = asAttr $ MkAttr (toName n, pAttrVal "false") -instance (Monad m, IsName n) => EmbedAsAttr (ServerPartT m) (Attr n Int) where-    asAttr (n := i)  = asAttr $ MkAttr (toName n, pAttrVal (show i))+instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n Int) where+    asAttr (n := i)  = asAttr $ MkAttr (toName n, pAttrVal (TL.pack $ show i)) -instance (Monad m, Functor m, IsName n) => (EmbedAsAttr (ServerPartT m) (Attr n TL.Text)) where-    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ TL.unpack a)+instance (Functor m, Monad m, IsName n TL.Text) => (EmbedAsAttr (ServerPartT m) (Attr n TL.Text)) where+    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ a) -instance (Monad m, Functor m, IsName n) => (EmbedAsAttr (ServerPartT m) (Attr n T.Text)) where-    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ T.unpack a)+instance (Functor m, Monad m, IsName n TL.Text) => (EmbedAsAttr (ServerPartT m) (Attr n T.Text)) where+    asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ TL.fromStrict a) -instance (Monad m) => EmbedAsChild (ServerPartT m) Char where-    asChild = XMLGenT . return . (:[]) . SChild . pcdata . (:[])+instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) Char where+    asChild = XMLGenT . return . (:[]) . SChild . pcdata . TL.singleton -instance (Monad m) => EmbedAsChild (ServerPartT m) String where-    asChild = XMLGenT . return . (:[]) . SChild . pcdata+instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) String where+    asChild = XMLGenT . return . (:[]) . SChild . pcdata . TL.pack -instance (Monad m) => EmbedAsChild (ServerPartT m) Int where-    asChild = XMLGenT . return . (:[]) . SChild . pcdata . show+instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) Int where+    asChild = XMLGenT . return . (:[]) . SChild . pcdata . TL.pack . show -instance (Monad m) => EmbedAsChild (ServerPartT m) Integer where-    asChild = XMLGenT . return . (:[]) . SChild . pcdata . show+instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) Integer where+    asChild = XMLGenT . return . (:[]) . SChild . pcdata . TL.pack . show -instance (Monad m) => EmbedAsChild (ServerPartT m) XML where+instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) XML where     asChild = XMLGenT . return . (:[]) . SChild  instance Monad m => EmbedAsChild (ServerPartT m) () where   asChild () = return [] -instance (Monad m, Functor m) => (EmbedAsChild (ServerPartT m) TL.Text) where+instance (Functor m, Monad m) => (EmbedAsChild (ServerPartT m) TL.Text) where     asChild = asChild . TL.unpack -instance (Monad m, Functor m) => (EmbedAsChild (ServerPartT m) T.Text) where+instance (Functor m, Monad m) => (EmbedAsChild (ServerPartT m) T.Text) where     asChild = asChild . T.unpack -instance (Monad m) => AppendChild (ServerPartT m) XML where+instance (Functor m, Monad m) => AppendChild (ServerPartT m) XML where  appAll xml children = do         chs <- children         case xml of          CDATA _ _       -> return xml          Element n as cs -> return $ Element n as (cs ++ (map unSChild chs)) -instance (Monad m) => SetAttr (ServerPartT m) XML where+instance (Functor m, Monad m) => SetAttr (ServerPartT m) XML where  setAll xml hats = do         attrs <- hats         case xml of          CDATA _ _       -> return xml          Element n as cs -> return $ Element n (foldr (:) as (map unSAttr attrs)) cs -instance (Monad m) => XMLGenerator (ServerPartT m)+instance (Functor m, Monad m) => XMLGenerator (ServerPartT m)
src/Happstack/Server/HSP/HTML.hs view
@@ -1,40 +1,47 @@ -- | support for using HSP+Happstack for rendering HTML-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans -F -pgmFtrhsx #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans -F -pgmFhsx2hs #-} module Happstack.Server.HSP.HTML   ( defaultTemplate-  , webHSP-  , webHSP'-  , module HSP   ) where  import Control.Monad.Trans (MonadIO(), liftIO)-import qualified Data.ByteString.Char8 as P-import qualified Data.ByteString.Lazy.UTF8 as L+import Data.Monoid ((<>))+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy.Builder as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy as TL+import           Data.Text.Lazy (Text)+ import Control.Monad (liftM) import Happstack.Server   ( ToMessage(toMessage, toContentType, toResponse)   , Response   )-import HSP-import HSP.ServerPartT      () -- import 'instance XMLGen ServerPartT'-import Happstack.Server.HSX () -- import 'instance Happstack XMLGenT' -instance ToMessage XML where-    toContentType _ = P.pack "text/html;charset=utf-8"-    toMessage xml   = toMessage (html4Strict, xml)+import HSP+import HSP.HTML4  instance ToMessage (Maybe XMLMetaData, XML) where-    toContentType (Just md,_) = P.pack (contentType md)-    toContentType _ = P.pack "text/html;charset=utf-8"+    toContentType (Just md,_) = T.encodeUtf8 $ TL.toStrict (contentType md)+    toContentType _ = "text/html;charset=utf-8"+     toMessage (Just (XMLMetaData (showDt, dt) _ pr), xml) =-        L.fromString ((if showDt then (dt ++) else id) (pr xml))+         TL.encodeUtf8 $ TL.toLazyText ((if showDt then ((TL.fromLazyText dt) <>) else id) (pr xml))+     toMessage (Nothing, xml) =-        L.fromString (renderAsHTML xml)+        TL.encodeUtf8 (renderAsHTML xml) ++instance ToMessage XML where+    toContentType _ = "text/html;charset=utf-8"+    toMessage xml   = toMessage (html4Strict, xml)++ -- | A generic webpage template-defaultTemplate :: (XMLGenerator m, EmbedAsChild m headers, EmbedAsChild m body) =>-                   String   -- ^ text to use in \<title\> tag+defaultTemplate :: ( XMLGenerator m, EmbedAsChild m headers+                   , EmbedAsChild m body, StringType m ~ Text) =>+                   TL.Text  -- ^ text to use in \<title\> tag                 -> headers  -- ^ extra headers to insert in \<head\> tag. Use @()@ if none.                 -> body     -- ^ content to put between the \<body\> tags.                 -> m (XMLType m)@@ -49,14 +56,3 @@       <% body %>      </body>     </html>---- | Converts a @HSP XML@ to a Happstack 'Response'.--- Since @HSP XML@ is the type returned by using literal HTML syntax--- with HSP, you can wrap up your HTML as webHSP $ \<html\>...\</html\>--- to use it with Happstack.-webHSP :: (MonadIO m) => HSP XML -> m Response-webHSP = webHSP' Nothing---- | webHSP with 'XMLMetaData'-webHSP' :: (MonadIO m) => Maybe XMLMetaData -> HSP XML -> m Response-webHSP' metadata hsp = toResponse `liftM` liftIO (evalHSP metadata hsp)
− src/Happstack/Server/HSX.hs 
@@ -1,29 +0,0 @@--- | This module contains orphan 'XMLGenT' instances for 'ServerMonad', 'FilterMonad', 'WebMonad', 'HasRqData', and 'Happstack'. It does not export any functions.-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Happstack.Server.HSX where--import Control.Applicative         (Alternative(..))-import Control.Monad               (MonadPlus(..))-import Control.Monad.Trans         (MonadIO(..))-import Happstack.Server.SimpleHTTP (ServerMonad(..), FilterMonad(..), WebMonad(..), HasRqData(..), Happstack(..), Response)-import HSX.XMLGenerator            (XMLGenT(..))--instance (ServerMonad m) => ServerMonad (XMLGenT m) where-    askRq = XMLGenT askRq-    localRq f (XMLGenT m) = XMLGenT (localRq f m)--instance (FilterMonad a m) => FilterMonad a (XMLGenT m) where-    setFilter = XMLGenT . setFilter-    composeFilter f = XMLGenT (composeFilter f)-    getFilter (XMLGenT m) = XMLGenT (getFilter m)--instance (WebMonad a m) => WebMonad a (XMLGenT m) where-    finishWith r = XMLGenT $ finishWith r--instance (HasRqData m) => (HasRqData (XMLGenT m)) where-    askRqEnv = XMLGenT askRqEnv-    localRqEnv f (XMLGenT m) = XMLGenT (localRqEnv f m)-    rqDataError = XMLGenT . rqDataError--instance (Alternative m, MonadPlus m, Functor m, MonadIO m, ServerMonad m, FilterMonad a m, WebMonad a m, HasRqData m, a ~ Response) => Happstack (XMLGenT m)
+ src/Happstack/Server/XMLGenT.hs view
@@ -0,0 +1,29 @@+-- | This module contains orphan 'XMLGenT' instances for 'ServerMonad', 'FilterMonad', 'WebMonad', 'HasRqData', and 'Happstack'. It does not export any functions.+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Happstack.Server.XMLGenT where++import Control.Applicative         (Alternative(..))+import Control.Monad               (MonadPlus(..))+import Control.Monad.Trans         (MonadIO(..))+import Happstack.Server.SimpleHTTP (ServerMonad(..), FilterMonad(..), WebMonad(..), HasRqData(..), Happstack(..), Response)+import HSP.XMLGenerator            (XMLGenT(..))++instance (ServerMonad m) => ServerMonad (XMLGenT m) where+    askRq = XMLGenT askRq+    localRq f (XMLGenT m) = XMLGenT (localRq f m)++instance (FilterMonad a m) => FilterMonad a (XMLGenT m) where+    setFilter = XMLGenT . setFilter+    composeFilter f = XMLGenT (composeFilter f)+    getFilter (XMLGenT m) = XMLGenT (getFilter m)++instance (WebMonad a m) => WebMonad a (XMLGenT m) where+    finishWith r = XMLGenT $ finishWith r++instance (HasRqData m) => (HasRqData (XMLGenT m)) where+    askRqEnv = XMLGenT askRqEnv+    localRqEnv f (XMLGenT m) = XMLGenT (localRqEnv f m)+    rqDataError = XMLGenT . rqDataError++instance (Alternative m, MonadPlus m, Functor m, MonadIO m, ServerMonad m, FilterMonad a m, WebMonad a m, HasRqData m, a ~ Response) => Happstack (XMLGenT m)