Removed Data.Object.Instances
This commit is contained in:
Michael Snoyman
parent
00115f02d4
commit
002f6ef788
@ -1,107 +0,0 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
---------------------------------------------------------
|
||||
--
|
||||
-- Module : Data.Object.Instances
|
||||
-- Copyright : Michael Snoyman
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
||||
-- Stability : Stable
|
||||
-- Portability : portable
|
||||
--
|
||||
-- Instances for converting various types of data into Data.Object.Object.
|
||||
--
|
||||
---------------------------------------------------------
|
||||
module Data.Object.Instances
|
||||
( Json (..)
|
||||
, Yaml (..)
|
||||
, Html (..)
|
||||
) where
|
||||
|
||||
import Data.Object.Text
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Web.Encodings (encodeJson)
|
||||
import Text.Yaml (encodeText')
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Convertible.Text
|
||||
|
||||
newtype Json = Json { unJson :: Text }
|
||||
instance ConvertAttempt (Object Text Text) Json where
|
||||
convertAttempt = return . convertSuccess
|
||||
instance ConvertSuccess (Object Text Text) Json where
|
||||
convertSuccess = Json . helper where
|
||||
helper :: TextObject -> Text
|
||||
helper (Scalar s) = LT.concat
|
||||
[ LT.pack "\""
|
||||
, bsToText $ encodeJson $ convertSuccess s
|
||||
, LT.pack "\""
|
||||
]
|
||||
helper (Sequence s) = LT.concat
|
||||
[ LT.pack "["
|
||||
, LT.intercalate (LT.pack ",") $ map helper s
|
||||
, LT.pack "]"
|
||||
]
|
||||
helper (Mapping m) = LT.concat
|
||||
[ LT.pack "{"
|
||||
, LT.intercalate (LT.pack ",") $ map helper2 m
|
||||
, LT.pack "}"
|
||||
]
|
||||
helper2 :: (Text, TextObject) -> Text
|
||||
helper2 (k, v) = LT.concat
|
||||
[ LT.pack "\""
|
||||
, bsToText $ encodeJson $ convertSuccess k
|
||||
, LT.pack "\":"
|
||||
, helper v
|
||||
]
|
||||
|
||||
bsToText :: B.ByteString -> Text
|
||||
bsToText = convertSuccess
|
||||
|
||||
newtype Yaml = Yaml { unYaml :: Text }
|
||||
instance ConvertAttempt (Object Text Text) Yaml where
|
||||
convertAttempt = return . convertSuccess
|
||||
instance ConvertSuccess (Object Text Text) Yaml where
|
||||
convertSuccess = Yaml . convertSuccess . encodeText'
|
||||
|
||||
-- | Represents as an entire HTML 5 document by using the following:
|
||||
--
|
||||
-- * A scalar is a paragraph.
|
||||
-- * A sequence is an unordered list.
|
||||
-- * A mapping is a definition list.
|
||||
newtype Html = Html { unHtml :: Text }
|
||||
|
||||
instance ConvertAttempt (Object Text Text) Html where
|
||||
convertAttempt = return . convertSuccess
|
||||
instance ConvertSuccess (Object Text Text) Html where
|
||||
convertSuccess o = Html $ LT.concat
|
||||
[ LT.pack "<!DOCTYPE html>\n<html><body>" -- FIXME full doc or just fragment?
|
||||
, helper o
|
||||
, LT.pack "</body></html>"
|
||||
] where
|
||||
helper :: TextObject -> Text
|
||||
helper (Scalar s) = LT.concat
|
||||
[ LT.pack "<p>"
|
||||
, s
|
||||
, LT.pack "</p>"
|
||||
]
|
||||
helper (Sequence []) = LT.pack "<ul></ul>"
|
||||
helper (Sequence s) = LT.concat
|
||||
[ LT.pack "<ul><li>"
|
||||
, LT.intercalate (LT.pack "</li><li>") $ map helper s
|
||||
, LT.pack "</li></ul>"
|
||||
]
|
||||
helper (Mapping m) = LT.concat $
|
||||
LT.pack "<dl>" :
|
||||
map helper2 m ++
|
||||
[ LT.pack "</dl>" ]
|
||||
helper2 :: (Text, TextObject) -> Text
|
||||
helper2 (k, v) = LT.concat
|
||||
[ LT.pack "<dt>"
|
||||
, k
|
||||
, LT.pack "</dt><dd>"
|
||||
, helper v
|
||||
, LT.pack "</dd>"
|
||||
]
|
||||
@ -23,8 +23,6 @@ module Yesod.Application
|
||||
) where
|
||||
|
||||
import Web.Encodings
|
||||
import Data.Object.Text
|
||||
import Data.Object.String
|
||||
import Data.Enumerable
|
||||
import Control.Monad (when)
|
||||
|
||||
@ -63,19 +61,6 @@ class ResourceName a => RestfulApp a where
|
||||
|
||||
-- | Output error response pages.
|
||||
errorHandler :: Monad m => a -> RawRequest -> ErrorResult -> [RepT m] -- FIXME better type sig?
|
||||
errorHandler _ rr NotFound = reps $ toTextObject $
|
||||
"Not found: " ++ show rr
|
||||
errorHandler _ _ (Redirect url) =
|
||||
reps $ toTextObject $ "Redirect to: " ++ url
|
||||
errorHandler _ _ (InternalError e) =
|
||||
reps $ toTextObject $ "Internal server error: " ++ e
|
||||
errorHandler _ _ (InvalidArgs ia) =
|
||||
reps $ toTextObject $ toStringObject
|
||||
[ ("errorMsg", toStringObject "Invalid arguments")
|
||||
, ("messages", toStringObject ia)
|
||||
]
|
||||
errorHandler _ _ PermissionDenied =
|
||||
reps $ toTextObject "Permission denied"
|
||||
|
||||
-- | Whether or not we should check for overlapping resource names.
|
||||
checkOverlaps :: a -> Bool
|
||||
|
||||
@ -154,6 +154,12 @@ rpxnowLogin apiKey = do
|
||||
header authCookieName $ Rpxnow.identifier ident
|
||||
redirect dest
|
||||
|
||||
authCheck :: Handler
|
||||
authCheck = error "authCheck"
|
||||
|
||||
authLogout :: Handler
|
||||
authLogout = error "authLogout"
|
||||
{- FIXME
|
||||
authCheck :: Handler
|
||||
authCheck = do
|
||||
ident <- maybeIdentifier
|
||||
@ -168,3 +174,4 @@ authLogout :: Handler
|
||||
authLogout = do
|
||||
deleteCookie authCookieName
|
||||
return $ objectResponse [("status", "loggedout")]
|
||||
-}
|
||||
|
||||
@ -38,7 +38,6 @@ module Yesod.Response
|
||||
-- * Generic responses
|
||||
, genResponse
|
||||
, htmlResponse
|
||||
, objectResponse
|
||||
#if TEST
|
||||
-- * Tests
|
||||
, testSuite
|
||||
@ -47,8 +46,6 @@ module Yesod.Response
|
||||
|
||||
import Yesod.Definitions
|
||||
import Data.Time.Clock
|
||||
import Data.Object.Text
|
||||
import Data.Object.Instances
|
||||
import qualified Data.ByteString as SBS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Text as ST
|
||||
@ -171,25 +168,6 @@ genResponse ct t = [(ct, return $ toContent t)]
|
||||
htmlResponse :: (Monad m, ToContent t) => t -> [RepT m]
|
||||
htmlResponse = genResponse "text/html"
|
||||
|
||||
-- | Return a response from an Object.
|
||||
objectResponse :: (Monad m, ToObject o Text Text) => o -> [RepT m]
|
||||
objectResponse = reps . toTextObject
|
||||
|
||||
-- HasReps instances
|
||||
instance Monad m => HasReps () m where
|
||||
reps _ = [("text/plain", return $ toContent "")]
|
||||
instance Monad m => HasReps TextObject m where
|
||||
reps o =
|
||||
[ ("text/html", return $ toContent $ unHtml $ convertSuccess o)
|
||||
, ("application/json", return $ toContent $ unJson $ convertSuccess o)
|
||||
, ("text/yaml", return $ toContent $ unYaml $ convertSuccess o)
|
||||
]
|
||||
|
||||
{- FIXME
|
||||
instance HasReps (Reps m) where
|
||||
reps = id
|
||||
-}
|
||||
|
||||
#if TEST
|
||||
----- Testing
|
||||
testSuite :: Test
|
||||
|
||||
@ -55,7 +55,6 @@ library
|
||||
Yesod.Resource
|
||||
Yesod.Yesod
|
||||
Data.Object.Html
|
||||
Data.Object.Instances
|
||||
Hack.Middleware.MethodOverride
|
||||
Hack.Middleware.ClientSession
|
||||
Hack.Middleware.Jsonp
|
||||
|
||||
Loading…
Reference in New Issue
Block a user