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