From a5893f5621ad5edb9f8da21943ac1d79b79dcb40 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 11 Jan 2010 00:59:10 +0200 Subject: [PATCH] Fixed other code to reflect HtmlObject changes --- Data/Object/Html.hs | 44 ++++++++++++++++++++++++-------------------- Yesod.hs | 2 -- Yesod/Rep.hs | 5 ++--- 3 files changed, 26 insertions(+), 25 deletions(-) diff --git a/Data/Object/Html.hs b/Data/Object/Html.hs index c1eaeed8..3a228cf1 100644 --- a/Data/Object/Html.hs +++ b/Data/Object/Html.hs @@ -19,6 +19,7 @@ module Data.Object.Html ( -- * Data type Html (..) , HtmlDoc (..) + , HtmlFragment (..) , HtmlObject -- * XML helpers , XmlDoc (..) @@ -38,7 +39,6 @@ import Data.Object.Text import Data.Object.Json import qualified Data.Text.Lazy as TL import qualified Data.Text as TS -import Data.ByteString.Lazy (ByteString) import Web.Encodings import Text.StringTemplate.Classes import Control.Arrow (second) @@ -84,6 +84,19 @@ $(deriveAttempts , (''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 pairs rest = foldr ($) rest $ map helper pairs where helper :: (String, String) -> String -> String @@ -114,9 +127,8 @@ htmlToText xml (HtmlList l) = \rest -> newtype HtmlFragment = HtmlFragment { unHtmlFragment :: Text } instance ConvertSuccess Html HtmlFragment where convertSuccess h = HtmlFragment . TL.fromChunks . htmlToText False h $ [] --- FIXME remove the next instance -instance ConvertSuccess Html Text where - convertSuccess h = TL.fromChunks . htmlToText False h $ [] +instance ConvertSuccess HtmlFragment Html where + convertSuccess = HtmlList . map Html . TL.toChunks . unHtmlFragment -- | Not fully typesafe. You must make sure that when converting to this, the -- 'Html' starts with a tag. newtype XmlDoc = XmlDoc { unXmlDoc :: Text } @@ -133,18 +145,11 @@ cdata h = HtmlList , 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 - convertSuccess h = HtmlDoc $ TL.concat - [ cs "HtmlDoc (autogenerated)" - , cs "" - , cs h - , cs "" - ] + convertSuccess h = HtmlDoc $ TL.fromChunks $ + cs "\nHtmlDoc (autogenerated)" + : htmlToText False h + [cs ""] instance ConvertSuccess HtmlObject Html where convertSuccess (Scalar h) = h @@ -162,25 +167,24 @@ instance ConvertSuccess HtmlObject HtmlDoc where convertSuccess = cs . (cs :: HtmlObject -> Html) instance ConvertSuccess Html JsonScalar where - convertSuccess = cs . (cs :: Html -> Text) + convertSuccess = cs . unHtmlFragment . cs instance ConvertSuccess HtmlObject JsonObject where convertSuccess = mapKeysValues convertSuccess convertSuccess instance ConvertSuccess HtmlObject JsonDoc where convertSuccess = cs . (cs :: HtmlObject -> JsonObject) $(deriveAttempts - [ (''Html, ''String) - , (''Html, ''Text) + [ (''Html, ''HtmlFragment) , (''Html, ''HtmlDoc) , (''Html, ''JsonScalar) ]) $(deriveSuccessConvs ''String ''Html [''String, ''Text] - [''Html, ''String, ''Text]) + [''Html, ''HtmlFragment]) 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 (Mapping pairs) = helper $ map (second toSElem) pairs where helper :: [(String, SElem b)] -> SElem b diff --git a/Yesod.hs b/Yesod.hs index fdc2ce15..8ebda038 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -24,7 +24,6 @@ module Yesod , module Yesod.Parameter , module Yesod.Rep , module Yesod.Template - , module Data.Convertible.Text , Application ) where @@ -48,4 +47,3 @@ import Yesod.Definitions import Yesod.Handler import Hack (Application) import Yesod.Template -import Data.Convertible.Text diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs index 54bcc786..509a9f32 100644 --- a/Yesod/Rep.hs +++ b/Yesod/Rep.hs @@ -57,7 +57,6 @@ import Data.Object.Html #endif import Data.Object.Json -import Data.Convertible.Text import Text.StringTemplate #if TEST @@ -109,8 +108,8 @@ instance ConvertSuccess ByteString Content where convertSuccess = Content instance ConvertSuccess String Content where convertSuccess = Content . cs -instance ConvertSuccess Html Content where - convertSuccess = Content . cs +instance ConvertSuccess HtmlDoc Content where + convertSuccess = cs . unHtmlDoc instance ConvertSuccess XmlDoc Content where convertSuccess = cs . unXmlDoc