diff --git a/Data/Object/Instances.hs b/Data/Object/Instances.hs index 3f6d21f5..13402e71 100644 --- a/Data/Object/Instances.hs +++ b/Data/Object/Instances.hs @@ -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 "" ] where - helper :: Object -> B.ByteString + helper :: RawObject -> B.ByteString helper (Scalar s) = B.concat [ toLazyByteString "

" , toLazyByteString s @@ -88,7 +88,7 @@ instance SafeFromObject Html where toLazyByteString "

" : map helper2 m ++ [ toLazyByteString "
" ] - helper2 :: (B.ByteString, Object) -> B.ByteString + helper2 :: (B.ByteString, RawObject) -> B.ByteString helper2 (k, v) = B.concat $ [ toLazyByteString "
" , toLazyByteString k diff --git a/TODO b/TODO index c1392343..8b7003ca 100644 --- a/TODO +++ b/TODO @@ -1,4 +1,3 @@ Catch exceptions and return as 500 errors approot -remove listDetail? int patterns (#name) diff --git a/Web/Restful/Application.hs b/Web/Restful/Application.hs index 0fe3dbcd..a847a09a 100644 --- a/Web/Restful/Application.hs +++ b/Web/Restful/Application.hs @@ -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. diff --git a/Web/Restful/Generic/ListDetail.hs b/Web/Restful/Generic/ListDetail.hs deleted file mode 100644 index 6c4c45e7..00000000 --- a/Web/Restful/Generic/ListDetail.hs +++ /dev/null @@ -1,55 +0,0 @@ ---------------------------------------------------------- --- --- Module : Web.Restful.Generic.ListDetail --- Copyright : Michael Snoyman --- License : BSD3 --- --- Maintainer : Michael Snoyman --- 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 = "" - where - helper i = "
  • " ++ encodeHtml (detailTitle i) ++ - "
  • " - -- | 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) - ] diff --git a/Web/Restful/Response.hs b/Web/Restful/Response.hs index 05b6746a..b7db0128 100644 --- a/Web/Restful/Response.hs +++ b/Web/Restful/Response.hs @@ -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) diff --git a/restful.cabal b/restful.cabal index 9981621f..fe8e7e91 100644 --- a/restful.cabal +++ b/restful.cabal @@ -1,5 +1,5 @@ name: restful -version: 0.1.4 +version: 0.1.5 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -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