data-object 0.2.0
This commit is contained in:
Michael Snoyman
parent
7addde1ec4
commit
16d9c06279
@ -26,12 +26,12 @@ import Web.Encodings (encodeJson)
|
||||
import Text.Yaml (encode)
|
||||
|
||||
class SafeFromObject a where
|
||||
safeFromObject :: Object -> a
|
||||
safeFromObject :: RawObject -> a
|
||||
|
||||
newtype Json = Json { unJson :: B.ByteString }
|
||||
instance SafeFromObject Json where
|
||||
safeFromObject = Json . helper where
|
||||
helper :: Object -> B.ByteString
|
||||
helper :: RawObject -> B.ByteString
|
||||
helper (Scalar s) = B.concat
|
||||
[ toLazyByteString "\""
|
||||
, encodeJson $ fromLazyByteString s
|
||||
@ -47,7 +47,7 @@ instance SafeFromObject Json where
|
||||
, B.intercalate (toLazyByteString ",") $ map helper2 m
|
||||
, toLazyByteString "}"
|
||||
]
|
||||
helper2 :: (B.ByteString, Object) -> B.ByteString
|
||||
helper2 :: (B.ByteString, RawObject) -> B.ByteString
|
||||
helper2 (k, v) = B.concat
|
||||
[ toLazyByteString "\""
|
||||
, encodeJson $ fromLazyByteString k
|
||||
@ -72,7 +72,7 @@ instance SafeFromObject Html where
|
||||
, helper o
|
||||
, toLazyByteString "</body></html>"
|
||||
] where
|
||||
helper :: Object -> B.ByteString
|
||||
helper :: RawObject -> B.ByteString
|
||||
helper (Scalar s) = B.concat
|
||||
[ toLazyByteString "<p>"
|
||||
, toLazyByteString s
|
||||
@ -88,7 +88,7 @@ instance SafeFromObject Html where
|
||||
toLazyByteString "<dl>" :
|
||||
map helper2 m ++
|
||||
[ toLazyByteString "</dl>" ]
|
||||
helper2 :: (B.ByteString, Object) -> B.ByteString
|
||||
helper2 :: (B.ByteString, RawObject) -> B.ByteString
|
||||
helper2 (k, v) = B.concat $
|
||||
[ toLazyByteString "<dt>"
|
||||
, toLazyByteString k
|
||||
|
||||
1
TODO
1
TODO
@ -1,4 +1,3 @@
|
||||
Catch exceptions and return as 500 errors
|
||||
approot
|
||||
remove listDetail?
|
||||
int patterns (#name)
|
||||
|
||||
@ -67,18 +67,18 @@ class ResourceName a b => RestfulApp a b | a -> b where
|
||||
|
||||
-- | Output error response pages.
|
||||
errorHandler :: a -> RawRequest -> ErrorResult -> Reps
|
||||
errorHandler _ rr NotFound = reps $ toObject $ "Not found: " ++ show rr
|
||||
errorHandler _ rr NotFound = reps $ toRawObject $ "Not found: " ++ show rr
|
||||
errorHandler _ _ (Redirect url) =
|
||||
reps $ toObject $ "Redirect to: " ++ url
|
||||
reps $ toRawObject $ "Redirect to: " ++ url
|
||||
errorHandler _ _ (InternalError e) =
|
||||
reps $ toObject $ "Internal server error: " ++ e
|
||||
reps $ toRawObject $ "Internal server error: " ++ e
|
||||
errorHandler _ _ (InvalidArgs ia) =
|
||||
reps $ toObject
|
||||
[ ("errorMsg", toObject "Invalid arguments")
|
||||
, ("messages", toObject ia)
|
||||
reps $ toRawObject
|
||||
[ ("errorMsg", toRawObject "Invalid arguments")
|
||||
, ("messages", toRawObject ia)
|
||||
]
|
||||
errorHandler _ _ PermissionDenied =
|
||||
reps $ toObject "Permission denied"
|
||||
reps $ toRawObject "Permission denied"
|
||||
|
||||
-- | Given a sample resource name (purely for typing reasons), generating
|
||||
-- a Hack application.
|
||||
|
||||
@ -1,55 +0,0 @@
|
||||
---------------------------------------------------------
|
||||
--
|
||||
-- Module : Web.Restful.Generic.ListDetail
|
||||
-- Copyright : Michael Snoyman
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
||||
-- Stability : Stable
|
||||
-- Portability : portable
|
||||
--
|
||||
-- Generic responses for listing items and then detailing them.
|
||||
--
|
||||
---------------------------------------------------------
|
||||
module Web.Restful.Generic.ListDetail
|
||||
( ListDetail (..)
|
||||
, ItemList (..)
|
||||
, ItemDetail (..)
|
||||
) where
|
||||
|
||||
import Web.Restful.Response
|
||||
import Web.Encodings
|
||||
import Data.Object
|
||||
import Data.Object.Instances
|
||||
import Data.ByteString.Class
|
||||
|
||||
class ToObject a => ListDetail a where
|
||||
htmlDetail :: a -> String
|
||||
htmlDetail = fromLazyByteString . unHtml . safeFromObject . toObject
|
||||
detailTitle :: a -> String
|
||||
detailUrl :: a -> String
|
||||
htmlList :: [a] -> String
|
||||
htmlList l = "<ul>" ++ concatMap helper l ++ "</ul>"
|
||||
where
|
||||
helper i = "<li><a href=\"" ++ encodeHtml (detailUrl i) ++
|
||||
"\">" ++ encodeHtml (detailTitle i) ++
|
||||
"</a></li>"
|
||||
-- | Often times for the JSON response of the list, we don't need all
|
||||
-- the information.
|
||||
treeList :: [a] -> Object -- FIXME
|
||||
treeList = Sequence . map treeListSingle
|
||||
treeListSingle :: a -> Object
|
||||
treeListSingle = toObject
|
||||
|
||||
newtype ItemList a = ItemList [a]
|
||||
instance ListDetail a => HasReps (ItemList a) where
|
||||
reps (ItemList l) =
|
||||
[ ("text/html", toLazyByteString $ htmlList l)
|
||||
, ("application/json", unJson $ safeFromObject $ treeList l)
|
||||
]
|
||||
newtype ItemDetail a = ItemDetail a
|
||||
instance ListDetail a => HasReps (ItemDetail a) where
|
||||
reps (ItemDetail i) =
|
||||
[ ("text/html", toLazyByteString $ htmlDetail i)
|
||||
, ("application/json", unJson $ safeFromObject $ toObject i)
|
||||
]
|
||||
@ -36,7 +36,7 @@ module Web.Restful.Response
|
||||
|
||||
import Data.ByteString.Class
|
||||
import Data.Time.Clock
|
||||
import Data.Object
|
||||
import Data.Object hiding (testSuite)
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.Object.Instances
|
||||
|
||||
@ -112,13 +112,13 @@ htmlResponse :: (Monad m, LazyByteString lbs) => lbs -> m Reps
|
||||
htmlResponse = genResponse "text/html"
|
||||
|
||||
-- | Return a response from an Object.
|
||||
objectResponse :: (Monad m, ToObject o) => o -> m Reps
|
||||
objectResponse = return . reps . toObject
|
||||
objectResponse :: (Monad m, ToRawObject o) => o -> m Reps
|
||||
objectResponse = return . reps . toRawObject
|
||||
|
||||
-- HasReps instances
|
||||
instance HasReps () where
|
||||
reps _ = [("text/plain", toLazyByteString "")]
|
||||
instance HasReps Object where
|
||||
instance HasReps RawObject where
|
||||
reps o =
|
||||
[ ("text/html", unHtml $ safeFromObject o)
|
||||
, ("application/json", unJson $ safeFromObject o)
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: restful
|
||||
version: 0.1.4
|
||||
version: 0.1.5
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
@ -29,8 +29,8 @@ library
|
||||
bytestring-class,
|
||||
web-encodings >= 0.0.1,
|
||||
mtl >= 1.1.0.2,
|
||||
data-object >= 0.0.2,
|
||||
yaml >= 0.0.4,
|
||||
data-object >= 0.2.0,
|
||||
yaml >= 0.2.0,
|
||||
test-framework,
|
||||
test-framework-quickcheck,
|
||||
test-framework-hunit,
|
||||
@ -52,6 +52,5 @@ library
|
||||
Web.Restful.Helpers.Auth,
|
||||
Web.Restful.Helpers.Static,
|
||||
Web.Restful.Response.AtomFeed,
|
||||
Web.Restful.Response.Sitemap,
|
||||
Web.Restful.Generic.ListDetail
|
||||
Web.Restful.Response.Sitemap
|
||||
ghc-options: -Wall -Werror
|
||||
|
||||
Loading…
Reference in New Issue
Block a user