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

Underlying libraries: remove To/FromObject

Browse Source
This commit is contained in:
Michael Snoyman 2009-12-16 20:27:38 +02:00
parent 498ed1cee5
commit f162ac54b3
3 changed files with 45 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
Data/Object/Html.hs
View File

@ -3,8 +3,10 @@
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
-- | An 'Html' data type and associated 'HtmlObject'. This has useful {-# LANGUAGE FlexibleInstances #-}
-- conversions in web development: {-# 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 -- * Automatic generation of simple HTML documents from 'HtmlObject' (mostly
-- useful for testing, you would never want to actually show them to an end -- 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 type HtmlObject = Object String Html
toHtmlObject :: ToObject x String Html => x -> HtmlObject toHtmlObject :: ConvertSuccess x HtmlObject => x -> HtmlObject
toHtmlObject = toObject toHtmlObject = cs
fromHtmlObject :: FromObject x String Html => HtmlObject -> Attempt x fromHtmlObject :: ConvertAttempt HtmlObject x => HtmlObject -> Attempt x
fromHtmlObject = fromObject fromHtmlObject = ca
instance ConvertSuccess String Html where instance ConvertSuccess String Html where
convertSuccess = Text . cs convertSuccess = Text . cs
instance ConvertSuccess Text Html where instance ConvertSuccess Text Html where
convertSuccess = Text 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 instance ConvertSuccess Html Text where
convertSuccess (Html t) = t convertSuccess (Html t) = t
@ -90,6 +107,9 @@ instance ConvertSuccess Html Text where
] ]
convertSuccess (HtmlList l) = TL.concat $ map cs l convertSuccess (HtmlList l) = TL.concat $ map cs l
instance ConvertSuccess Html String 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.concat
[ cs "<!DOCTYPE html><html><head><title>HtmlDoc (autogenerated)" [ cs "<!DOCTYPE html><html><head><title>HtmlDoc (autogenerated)"
@ -119,25 +139,22 @@ instance ConvertSuccess HtmlObject JsonObject where
instance ConvertSuccess HtmlObject JsonDoc where instance ConvertSuccess HtmlObject JsonDoc where
convertSuccess = cs . (cs :: HtmlObject -> JsonObject) convertSuccess = cs . (cs :: HtmlObject -> JsonObject)
instance ToObject Html String Html where $(deriveAttempts
toObject = Scalar [ (''Html, ''String)
, (''Html, ''Text)
, (''Html, ''HtmlDoc)
, (''Html, ''JsonScalar)
])
$(deriveSuccessConvs ''String ''Html
[''String, ''Text]
[''Html, ''String, ''Text])
instance ToSElem HtmlObject where instance ToSElem HtmlObject where
toSElem (Scalar h) = STR $ TL.unpack $ cs h toSElem (Scalar h) = STR $ TL.unpack $ cs h
toSElem (Sequence hs) = LI $ map toSElem hs toSElem (Sequence hs) = LI $ map toSElem hs
toSElem (Mapping pairs) = SM $ Map.fromList $ map (second toSElem) pairs 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 #if TEST
caseHtmlToText :: Assertion caseHtmlToText :: Assertion
caseHtmlToText = do caseHtmlToText = do
@ -183,7 +200,3 @@ testSuite = testGroup "Data.Object.Html"
] ]
#endif #endif
instance ToObject Char String Html where
toObject c = Scalar $ Text $ cs [c]
listToObject = Scalar . Text . cs

16
Yesod/Resource.hs
View File

@ -44,10 +44,9 @@ import Language.Haskell.TH
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Control.Exception (Exception) import Control.Exception (Exception)
import Data.Attempt -- for failure stuff import Data.Attempt -- for failure stuff
import Data.Convertible.Text
import Data.Object.Text import Data.Object.Text
import Control.Monad ((<=<)) import Control.Monad ((<=<))
import Text.Yaml import Data.Object.Yaml
#if TEST #if TEST
import Control.Monad (replicateM) import Control.Monad (replicateM)
@ -181,23 +180,22 @@ data VerbMap = AllVerbs String | Verbs [(Verb, String)]
deriving (Show, Eq) deriving (Show, Eq)
instance ConvertAttempt YamlDoc [RPNode] where instance ConvertAttempt YamlDoc [RPNode] where
convertAttempt = fromTextObject <=< ca convertAttempt = fromTextObject <=< ca
instance FromObject RPNode Text Text where instance ConvertAttempt TextObject [RPNode] where
fromObject = error "fromObject RPNode Text Text" convertAttempt = mapM helper <=< fromMapping where
listFromObject = mapM helper <=< fromMapping where
helper :: (Text, TextObject) -> Attempt RPNode helper :: (Text, TextObject) -> Attempt RPNode
helper (rp, rest) = do helper (rp, rest) = do
verbMap <- fromTextObject rest verbMap <- fromTextObject rest
let rp' = cs (cs rp :: String) let rp' = cs (cs rp :: String)
return $ RPNode rp' verbMap return $ RPNode rp' verbMap
instance FromObject VerbMap Text Text where instance ConvertAttempt TextObject VerbMap where
fromObject (Scalar s) = return $ AllVerbs $ cs s convertAttempt (Scalar s) = return $ AllVerbs $ cs s
fromObject (Mapping m) = Verbs `fmap` mapM helper m where convertAttempt (Mapping m) = Verbs `fmap` mapM helper m where
helper :: (Text, TextObject) -> Attempt (Verb, String) helper :: (Text, TextObject) -> Attempt (Verb, String)
helper (v, Scalar f) = do helper (v, Scalar f) = do
v' <- ca (cs v :: String) v' <- ca (cs v :: String)
return (v', cs f) return (v', cs f)
helper (_, x) = failure $ VerbMapNonScalar x helper (_, x) = failure $ VerbMapNonScalar x
fromObject o = failure $ VerbMapSequence o convertAttempt o = failure $ VerbMapSequence o
data RPNodeException = VerbMapNonScalar TextObject data RPNodeException = VerbMapNonScalar TextObject
| VerbMapSequence TextObject | VerbMapSequence TextObject
deriving (Show, Typeable) deriving (Show, Typeable)

4
yesod.cabal
View File

@ -36,7 +36,7 @@ library
bytestring >= 0.9.1.4 && < 0.10, bytestring >= 0.9.1.4 && < 0.10,
web-encodings >= 0.2.0 && < 0.3, web-encodings >= 0.2.0 && < 0.3,
data-object >= 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, enumerable >= 0.0.3 && < 0.1,
directory >= 1 && < 1.1, directory >= 1 && < 1.1,
transformers >= 0.1.4.0 && < 0.2, transformers >= 0.1.4.0 && < 0.2,
@ -44,7 +44,7 @@ library
control-monad-attempt >= 0.0.0 && < 0.1, control-monad-attempt >= 0.0.0 && < 0.1,
syb, syb,
text >= 0.5 && < 0.6, 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, clientsession >= 0.0.1 && < 0.1,
zlib >= 0.5.2.0 && < 0.6, zlib >= 0.5.2.0 && < 0.6,
containers >= 0.2.0.1 && < 0.3, containers >= 0.2.0.1 && < 0.3,