From f162ac54b33fe007e4a376f0dc079ed7fabe4c86 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 16 Dec 2009 20:27:38 +0200 Subject: [PATCH] Underlying libraries: remove To/FromObject --- Data/Object/Html.hs | 59 +++++++++++++++++++++++++++------------------ Yesod/Resource.hs | 16 ++++++------ yesod.cabal | 4 +-- 3 files changed, 45 insertions(+), 34 deletions(-) diff --git a/Data/Object/Html.hs b/Data/Object/Html.hs index 5ec42cc3..235ff927 100644 --- a/Data/Object/Html.hs +++ b/Data/Object/Html.hs @@ -3,8 +3,10 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} --- | An 'Html' data type and associated 'HtmlObject'. This has useful --- conversions in web development: +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +-- | An 'Html' data type and associated 'ConvertSuccess' instances. This has +-- useful conversions in web development: -- -- * Automatic generation of simple HTML documents from 'HtmlObject' (mostly -- useful for testing, you would never want to actually show them to an end @@ -58,16 +60,31 @@ newtype HtmlDoc = HtmlDoc { unHtmlDoc :: Text } type HtmlObject = Object String Html -toHtmlObject :: ToObject x String Html => x -> HtmlObject -toHtmlObject = toObject +toHtmlObject :: ConvertSuccess x HtmlObject => x -> HtmlObject +toHtmlObject = cs -fromHtmlObject :: FromObject x String Html => HtmlObject -> Attempt x -fromHtmlObject = fromObject +fromHtmlObject :: ConvertAttempt HtmlObject x => HtmlObject -> Attempt x +fromHtmlObject = ca instance ConvertSuccess String Html where convertSuccess = Text . cs instance ConvertSuccess Text Html where convertSuccess = Text +$(deriveAttempts + [ (''String, ''Html) + , (''Text, ''Html) + ]) + +showAttribs :: [(String, String)] -> Text +showAttribs = TL.concat . map helper where + helper :: (String, String) -> Text + helper (k, v) = TL.concat + [ cs " " + , encodeHtml $ cs k + , cs "=\"" + , encodeHtml $ cs v + , cs "\"" + ] instance ConvertSuccess Html Text where convertSuccess (Html t) = t @@ -90,6 +107,9 @@ instance ConvertSuccess Html Text where ] convertSuccess (HtmlList l) = TL.concat $ map cs l +instance ConvertSuccess Html String where + convertSuccess = cs . (cs :: Html -> Text) + instance ConvertSuccess Html HtmlDoc where convertSuccess h = HtmlDoc $ TL.concat [ cs "HtmlDoc (autogenerated)" @@ -119,25 +139,22 @@ instance ConvertSuccess HtmlObject JsonObject where instance ConvertSuccess HtmlObject JsonDoc where convertSuccess = cs . (cs :: HtmlObject -> JsonObject) -instance ToObject Html String Html where - toObject = Scalar +$(deriveAttempts + [ (''Html, ''String) + , (''Html, ''Text) + , (''Html, ''HtmlDoc) + , (''Html, ''JsonScalar) + ]) + +$(deriveSuccessConvs ''String ''Html + [''String, ''Text] + [''Html, ''String, ''Text]) instance ToSElem HtmlObject where toSElem (Scalar h) = STR $ TL.unpack $ cs h toSElem (Sequence hs) = LI $ map toSElem hs toSElem (Mapping pairs) = SM $ Map.fromList $ map (second toSElem) pairs -showAttribs :: [(String, String)] -> Text -showAttribs = TL.concat . map helper where - helper :: (String, String) -> Text - helper (k, v) = TL.concat - [ cs " " - , encodeHtml $ cs k - , cs "=\"" - , encodeHtml $ cs v - , cs "\"" - ] - #if TEST caseHtmlToText :: Assertion caseHtmlToText = do @@ -183,7 +200,3 @@ testSuite = testGroup "Data.Object.Html" ] #endif - -instance ToObject Char String Html where - toObject c = Scalar $ Text $ cs [c] - listToObject = Scalar . Text . cs diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs index 337acffd..a608b2b8 100644 --- a/Yesod/Resource.hs +++ b/Yesod/Resource.hs @@ -44,10 +44,9 @@ import Language.Haskell.TH import Data.Typeable (Typeable) import Control.Exception (Exception) import Data.Attempt -- for failure stuff -import Data.Convertible.Text import Data.Object.Text import Control.Monad ((<=<)) -import Text.Yaml +import Data.Object.Yaml #if TEST import Control.Monad (replicateM) @@ -181,23 +180,22 @@ data VerbMap = AllVerbs String | Verbs [(Verb, String)] deriving (Show, Eq) instance ConvertAttempt YamlDoc [RPNode] where convertAttempt = fromTextObject <=< ca -instance FromObject RPNode Text Text where - fromObject = error "fromObject RPNode Text Text" - listFromObject = mapM helper <=< fromMapping where +instance ConvertAttempt TextObject [RPNode] where + convertAttempt = mapM helper <=< fromMapping where helper :: (Text, TextObject) -> Attempt RPNode helper (rp, rest) = do verbMap <- fromTextObject rest let rp' = cs (cs rp :: String) return $ RPNode rp' verbMap -instance FromObject VerbMap Text Text where - fromObject (Scalar s) = return $ AllVerbs $ cs s - fromObject (Mapping m) = Verbs `fmap` mapM helper m where +instance ConvertAttempt TextObject VerbMap where + convertAttempt (Scalar s) = return $ AllVerbs $ cs s + convertAttempt (Mapping m) = Verbs `fmap` mapM helper m where helper :: (Text, TextObject) -> Attempt (Verb, String) helper (v, Scalar f) = do v' <- ca (cs v :: String) return (v', cs f) helper (_, x) = failure $ VerbMapNonScalar x - fromObject o = failure $ VerbMapSequence o + convertAttempt o = failure $ VerbMapSequence o data RPNodeException = VerbMapNonScalar TextObject | VerbMapSequence TextObject deriving (Show, Typeable) diff --git a/yesod.cabal b/yesod.cabal index dcec0e08..137fa631 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -36,7 +36,7 @@ library bytestring >= 0.9.1.4 && < 0.10, web-encodings >= 0.2.0 && < 0.3, data-object >= 0.2.0 && < 0.3, - yaml >= 0.2.0 && < 0.3, + data-object-yaml >= 0.0.0 && < 0.1, enumerable >= 0.0.3 && < 0.1, directory >= 1 && < 1.1, transformers >= 0.1.4.0 && < 0.2, @@ -44,7 +44,7 @@ library control-monad-attempt >= 0.0.0 && < 0.1, syb, text >= 0.5 && < 0.6, - convertible-text >= 0.0.1 && < 0.1, + convertible-text >= 0.2.0 && < 0.3, clientsession >= 0.0.1 && < 0.1, zlib >= 0.5.2.0 && < 0.6, containers >= 0.2.0.1 && < 0.3,