Permalink
Browse files

Added fromObjectWrap

  • Loading branch information...
1 parent fbff5f4 commit 23b33eeb3bac7deddfacd6eacf617c843baf2966 @snoyberg committed Nov 23, 2009
Showing with 38 additions and 2 deletions.
  1. +20 −2 Data/Object.hs
  2. +18 −0 Data/Object/Text.hs
View
@@ -1,6 +1,8 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ExistentialQuantification #-}
---------------------------------------------------------
--
-- Module : Data.Object
@@ -46,6 +48,9 @@ module Data.Object
-- * Higher level conversions
, ToObject (..)
, FromObject (..)
+ -- ** Wrapping 'FromObject'
+ , FromObjectException (..)
+ , fromObjectWrap
-- * Helper functions
, lookupObject
-- ** Scalar/Object conversions
@@ -68,7 +73,7 @@ import Data.Monoid
import Data.Generics
import qualified Safe.Failure as A
-import qualified Control.Exception as E
+import Control.Exception (Exception)
import Data.Attempt
import Data.Convertible
@@ -171,7 +176,7 @@ data ObjectExtractError =
| ExpectedSequence
| ExpectedMapping
deriving (Typeable, Show)
-instance E.Exception ObjectExtractError
+instance Exception ObjectExtractError
-- | Extra a scalar from the input, failing if the input is a sequence or
-- mapping.
@@ -340,6 +345,19 @@ instance (ConvertAttempt k' k, FromObject v k' v') => FromObject (k, v) k' v' wh
mapM (runKleisli (Kleisli convertAttempt *** Kleisli fromObject))
<=< fromMapping
+-- | Wraps any 'Exception' thrown during a 'fromObject' call.
+data FromObjectException = forall e. Exception e => FromObjectException e
+ deriving Typeable
+instance Show FromObjectException where
+ show (FromObjectException e) = "FromObjectException " ++ show e
+instance Exception FromObjectException
+
+-- | Calls 'fromObject' and wraps any 'Exception's in a 'FromObjectException'.
+fromObjectWrap :: (FromObject x k y, MonadFailure FromObjectException m)
+ => Object k y
+ -> m x
+fromObjectWrap = attempt (failure . FromObjectException) return . fromObject
+
-- | An equivalent of 'lookup' to deal specifically with maps of 'Object's. In
-- particular, it will:
--
View
@@ -19,6 +19,7 @@ module Data.Object.Text
( TextObject
, toTextObject
, fromTextObject
+ , Text
) where
import Data.Object
@@ -31,6 +32,9 @@ import Data.Convertible.Instances.String ()
import Data.Time.Calendar
import Data.Ratio (Ratio)
+import Data.Typeable (Typeable)
+import Control.Exception (Exception)
+
-- | 'Object's with keys and values of type 'LT.Text'.
type TextObject = Object Text Text
@@ -56,3 +60,17 @@ instance ToObject (Ratio Integer) Text Text where
toObject = Scalar . convertSuccess
instance ToObject Bool Text Text where
toObject = Scalar . convertSuccess
+
+newtype ExpectedCharException = ExpectedCharException String
+ deriving (Show, Typeable)
+instance Exception ExpectedCharException
+instance FromObject Char Text Text where
+ fromObject o = do
+ x <- fromScalar o
+ let y = convertSuccess x
+ case y of
+ [c] -> return c
+ _ -> failure $ ExpectedCharException y
+ listFromObject o = do
+ x <- fromScalar o
+ return $ convertSuccess x

0 comments on commit 23b33ee

Please sign in to comment.