Fixed other code to reflect HtmlObject changes
This commit is contained in:
Michael Snoyman
parent
1f9d11eb29
commit
a5893f5621
@ -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 "<!DOCTYPE html><html><head><title>HtmlDoc (autogenerated)"
|
||||
, cs "</title></head><body>"
|
||||
, cs h
|
||||
, cs "</body></html>"
|
||||
]
|
||||
convertSuccess h = HtmlDoc $ TL.fromChunks $
|
||||
cs "<!DOCTYPE html>\n<html><head><title>HtmlDoc (autogenerated)</title></head><body>"
|
||||
: htmlToText False h
|
||||
[cs "</body></html>"]
|
||||
|
||||
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
|
||||
|
||||
2
Yesod.hs
2
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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user