haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed other code to reflect HtmlObject changes

Browse Source
This commit is contained in:
Michael Snoyman 2010-01-11 00:59:10 +02:00
parent 1f9d11eb29
commit a5893f5621
3 changed files with 26 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
Data/Object/Html.hs
View File

@ -19,6 +19,7 @@ module Data.Object.Html
( -- * Data type ( -- * Data type
Html (..) Html (..)
, HtmlDoc (..) , HtmlDoc (..)
, HtmlFragment (..)
, HtmlObject , HtmlObject
-- * XML helpers -- * XML helpers
, XmlDoc (..) , XmlDoc (..)
@ -38,7 +39,6 @@ import Data.Object.Text
import Data.Object.Json import Data.Object.Json
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text as TS import qualified Data.Text as TS
import Data.ByteString.Lazy (ByteString)
import Web.Encodings import Web.Encodings
import Text.StringTemplate.Classes import Text.StringTemplate.Classes
import Control.Arrow (second) import Control.Arrow (second)
@ -84,6 +84,19 @@ $(deriveAttempts
, (''TS.Text, ''Html) , (''TS.Text, ''Html)
]) ])
instance ConvertSuccess String HtmlObject where
convertSuccess = Scalar . cs
instance ConvertSuccess Text HtmlObject where
convertSuccess = Scalar . cs
instance ConvertSuccess TS.Text HtmlObject where
convertSuccess = Scalar . cs
instance ConvertSuccess [(String, String)] HtmlObject where
convertSuccess = omTO
instance ConvertSuccess [(Text, Text)] HtmlObject where
convertSuccess = omTO
instance ConvertSuccess [(TS.Text, TS.Text)] HtmlObject where
convertSuccess = omTO
showAttribs :: [(String, String)] -> String -> String showAttribs :: [(String, String)] -> String -> String
showAttribs pairs rest = foldr ($) rest $ map helper pairs where showAttribs pairs rest = foldr ($) rest $ map helper pairs where
helper :: (String, String) -> String -> String helper :: (String, String) -> String -> String
@ -114,9 +127,8 @@ htmlToText xml (HtmlList l) = \rest ->
newtype HtmlFragment = HtmlFragment { unHtmlFragment :: Text } newtype HtmlFragment = HtmlFragment { unHtmlFragment :: Text }
instance ConvertSuccess Html HtmlFragment where instance ConvertSuccess Html HtmlFragment where
convertSuccess h = HtmlFragment . TL.fromChunks . htmlToText False h $ [] convertSuccess h = HtmlFragment . TL.fromChunks . htmlToText False h $ []
-- FIXME remove the next instance instance ConvertSuccess HtmlFragment Html where
instance ConvertSuccess Html Text where convertSuccess = HtmlList . map Html . TL.toChunks . unHtmlFragment
convertSuccess h = TL.fromChunks . htmlToText False h $ []
-- | Not fully typesafe. You must make sure that when converting to this, the -- | Not fully typesafe. You must make sure that when converting to this, the
-- 'Html' starts with a tag. -- 'Html' starts with a tag.
newtype XmlDoc = XmlDoc { unXmlDoc :: Text } newtype XmlDoc = XmlDoc { unXmlDoc :: Text }
@ -133,18 +145,11 @@ cdata h = HtmlList
, Html $ cs "]]>" , Html $ cs "]]>"
] ]
instance ConvertSuccess Html String where
convertSuccess = cs . (cs :: Html -> Text)
instance ConvertSuccess Html ByteString where
convertSuccess = cs . (cs :: Html -> Text)
instance ConvertSuccess Html HtmlDoc where instance ConvertSuccess Html HtmlDoc where
convertSuccess h = HtmlDoc $ TL.concat convertSuccess h = HtmlDoc $ TL.fromChunks $
[ cs "<!DOCTYPE html><html><head><title>HtmlDoc (autogenerated)" cs "<!DOCTYPE html>\n<html><head><title>HtmlDoc (autogenerated)</title></head><body>"
, cs "</title></head><body>" : htmlToText False h
, cs h [cs "</body></html>"]
, cs "</body></html>"
]
instance ConvertSuccess HtmlObject Html where instance ConvertSuccess HtmlObject Html where
convertSuccess (Scalar h) = h convertSuccess (Scalar h) = h
@ -162,25 +167,24 @@ instance ConvertSuccess HtmlObject HtmlDoc where
convertSuccess = cs . (cs :: HtmlObject -> Html) convertSuccess = cs . (cs :: HtmlObject -> Html)
instance ConvertSuccess Html JsonScalar where instance ConvertSuccess Html JsonScalar where
convertSuccess = cs . (cs :: Html -> Text) convertSuccess = cs . unHtmlFragment . cs
instance ConvertSuccess HtmlObject JsonObject where instance ConvertSuccess HtmlObject JsonObject where
convertSuccess = mapKeysValues convertSuccess convertSuccess convertSuccess = mapKeysValues convertSuccess convertSuccess
instance ConvertSuccess HtmlObject JsonDoc where instance ConvertSuccess HtmlObject JsonDoc where
convertSuccess = cs . (cs :: HtmlObject -> JsonObject) convertSuccess = cs . (cs :: HtmlObject -> JsonObject)
$(deriveAttempts $(deriveAttempts
[ (''Html, ''String) [ (''Html, ''HtmlFragment)
, (''Html, ''Text)
, (''Html, ''HtmlDoc) , (''Html, ''HtmlDoc)
, (''Html, ''JsonScalar) , (''Html, ''JsonScalar)
]) ])
$(deriveSuccessConvs ''String ''Html $(deriveSuccessConvs ''String ''Html
[''String, ''Text] [''String, ''Text]
[''Html, ''String, ''Text]) [''Html, ''HtmlFragment])
instance ToSElem HtmlObject where instance ToSElem HtmlObject where
toSElem (Scalar h) = STR $ TL.unpack $ cs h toSElem (Scalar h) = STR $ TL.unpack $ unHtmlFragment $ cs h
toSElem (Sequence hs) = LI $ map toSElem hs toSElem (Sequence hs) = LI $ map toSElem hs
toSElem (Mapping pairs) = helper $ map (second toSElem) pairs where toSElem (Mapping pairs) = helper $ map (second toSElem) pairs where
helper :: [(String, SElem b)] -> SElem b helper :: [(String, SElem b)] -> SElem b

2
Yesod.hs
View File

@ -24,7 +24,6 @@ module Yesod
, module Yesod.Parameter , module Yesod.Parameter
, module Yesod.Rep , module Yesod.Rep
, module Yesod.Template , module Yesod.Template
, module Data.Convertible.Text
, Application , Application
) where ) where
@ -48,4 +47,3 @@ import Yesod.Definitions
import Yesod.Handler import Yesod.Handler
import Hack (Application) import Hack (Application)
import Yesod.Template import Yesod.Template
import Data.Convertible.Text

5
Yesod/Rep.hs
View File

@ -57,7 +57,6 @@ import Data.Object.Html
#endif #endif
import Data.Object.Json import Data.Object.Json
import Data.Convertible.Text
import Text.StringTemplate import Text.StringTemplate
#if TEST #if TEST
@ -109,8 +108,8 @@ instance ConvertSuccess ByteString Content where
convertSuccess = Content convertSuccess = Content
instance ConvertSuccess String Content where instance ConvertSuccess String Content where
convertSuccess = Content . cs convertSuccess = Content . cs
instance ConvertSuccess Html Content where instance ConvertSuccess HtmlDoc Content where
convertSuccess = Content . cs convertSuccess = cs . unHtmlDoc
instance ConvertSuccess XmlDoc Content where instance ConvertSuccess XmlDoc Content where
convertSuccess = cs . unXmlDoc convertSuccess = cs . unXmlDoc