Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Created the Data.Object.Base module.

Data.Object imports all submodules.
submodules all reexport Data.Object.Base
  • Loading branch information...
commit 5f64bfd6d5d13880d6fc1c2aee8b1203ecfdc1b8 1 parent 362cf16
Michael Snoyman authored
406 Data/Object.hs
... ... @@ -1,404 +1,10 @@
1   -{-# LANGUAGE MultiParamTypeClasses #-}
2   -{-# LANGUAGE FlexibleInstances #-}
3   -{-# LANGUAGE FlexibleContexts #-}
4   -{-# LANGUAGE DeriveDataTypeable #-}
5   -{-# LANGUAGE ExistentialQuantification #-}
6   ----------------------------------------------------------
7   ---
8   --- Module : Data.Object
9   --- Copyright : Michael Snoyman
10   --- License : BSD3
11   ---
12   --- Maintainer : Michael Snoyman <michael@snoyman.com>
13   --- Stability : Stable
14   --- Portability : portable
15   ---
16   --- These objects show up in different places, eg JSON, Yaml.
17   --- By providing a representation in a separate repository,
18   --- other libraries can share a single representation of
19   --- these structures.
20   ---
21   ----------------------------------------------------------
22   -
23   --- | The core of this package is the 'Object' data type, which is used for
24   --- handling scalars, sequences and mappings in a nested manner. This
25   --- is the same structure used in JSON or Yaml data.
26   ---
27   --- The 'Object' data type is polymorphic in its keys and values. Submodules
28   --- within this package provide more concrete datatypes, such as a 'String'
29   --- 'Object' and a specialized scalar type.
30   ---
31   --- Besides the 'Object' data type, there are utility functions and type classes
32   --- for converting objects around. Care has been taken to avoid any overloaded
33   --- instances for these type classes.
  1 +-- | Imports all instances provided in this package.
34 2 module Data.Object
35   - ( -- * Object data type
36   - Object (..)
37   - -- * Basic mapping of keys and values
38   - , mapKeys
39   - , mapValues
40   - , mapKeysValues
41   - , mapKeysValuesA
42   - , mapKeysValuesM
43   - -- * Extracting underlying values
44   - , ObjectExtractError (..)
45   - , fromScalar
46   - , fromSequence
47   - , fromMapping
48   - -- * Higher level conversions
49   - , ToObject (..)
50   - , FromObject (..)
51   - -- ** Wrapping 'FromObject'
52   - , FromObjectException (..)
53   - , fromObjectWrap
54   - -- * Helper functions
55   - , lookupObject
56   - -- ** Scalar/Object conversions
57   - -- $scalarToFromObject
58   - , scalarToObject
59   - , scalarFromObject
  3 + ( module Data.Object.Base
60 4 ) where
61 5
62   -import Control.Arrow
63   -import Control.Applicative
64   -import Control.Monad (ap, (<=<))
65   -
66   -import Prelude hiding (mapM, sequence)
67   -
68   -import Data.Foldable
69   -import Data.Traversable
70   -import Data.Monoid
71   -
72   -import Data.Generics
73   -import qualified Safe.Failure as A
74   -import Control.Exception (Exception)
75   -import Data.Attempt
76   -
77   -import Data.Convertible.Text
78   -
79   --- | Can represent nested values as scalars, sequences and mappings. A
80   --- sequence is synonymous with a list, while a mapping is synonymous with a
81   --- list of pairs.
82   ---
83   --- Note that instances of standard library type classes for this data type
84   --- leave the key untouched while altering the value. For example, the 'Functor'
85   --- instance defines 'fmap' to be synonymous with 'mapValues'.
86   -data Object key val =
87   - Mapping [(key, Object key val)]
88   - | Sequence [Object key val]
89   - | Scalar val
90   - deriving (Show, Eq, Data, Typeable)
91   -
92   -instance Functor (Object key) where
93   - fmap = mapValues
94   -
95   -instance Foldable (Object key) where
96   - foldMap f (Scalar v) = f v
97   - foldMap f (Sequence vs) = mconcat $ map (foldMap f) vs
98   - foldMap f (Mapping pairs) = mconcat $ map (foldMap f . snd) pairs
99   -
100   -instance Traversable (Object key) where
101   - traverse f (Scalar v) = Scalar <$> f v
102   - traverse f (Sequence vs) = Sequence <$> traverse (traverse f) vs
103   - traverse f (Mapping pairs) =
104   - Mapping <$> traverse (traverse' (traverse f)) pairs
105   -
106   --- It would be nice if there were an "instance Traversable ((,) a)", but I
107   --- won't make an orphan instance simply for convenience. Instead:
108   -traverse' :: Applicative f => (a -> f b) -> (x, a) -> f (x, b)
109   -traverse' f (x, a) = (,) x <$> f a
110   -
111   -joinObj :: Object key (Object key scalar) -> Object key scalar
112   -joinObj (Scalar x) = x
113   -joinObj (Sequence xs) = Sequence (map joinObj xs)
114   -joinObj (Mapping xs) = Mapping (map (second joinObj) xs)
115   -
116   -instance Monad (Object key) where
117   - return = Scalar
118   - x >>= f = joinObj . fmap f $ x
119   -
120   -instance Applicative (Object key) where
121   - pure = Scalar
122   - (<*>) = ap
123   -
124   --- | Apply some conversion to the keys of an 'Object', leaving the values
125   --- unchanged.
126   -mapKeys :: (keyIn -> keyOut) -> Object keyIn val -> Object keyOut val
127   -mapKeys = flip mapKeysValues id
128   -
129   --- | Apply some conversion to the values of an 'Object', leaving the keys
130   --- unchanged. This is equivalent to 'fmap'.
131   -mapValues :: (valIn -> valOut) -> Object key valIn -> Object key valOut
132   -mapValues = mapKeysValues id
133   -
134   --- | Apply a conversion to both the keys and values of an 'Object'.
135   -mapKeysValues :: (keyIn -> keyOut)
136   - -> (valIn -> valOut)
137   - -> Object keyIn valIn
138   - -> Object keyOut valOut
139   -mapKeysValues _ fv (Scalar v) = Scalar $ fv v
140   -mapKeysValues fk fv (Sequence os)= Sequence $ map (mapKeysValues fk fv) os
141   -mapKeysValues fk fv (Mapping pairs) =
142   - Mapping $ map (fk *** mapKeysValues fk fv) pairs
143   -
144   --- | Apply an 'Applicative' conversion to both the keys and values of an
145   --- 'Object'.
146   -mapKeysValuesA :: Applicative f
147   - => (keyIn -> f keyOut)
148   - -> (valIn -> f valOut)
149   - -> Object keyIn valIn
150   - -> f (Object keyOut valOut)
151   -mapKeysValuesA _ fv (Scalar v) = Scalar <$> fv v
152   -mapKeysValuesA fk fv (Sequence os) =
153   - Sequence <$> traverse (mapKeysValuesA fk fv) os
154   -mapKeysValuesA fk fv (Mapping pairs) = Mapping <$>
155   - traverse (uncurry (liftA2 (,)) . (fk *** mapKeysValuesA fk fv)) pairs
156   -
157   --- | The same as 'mapKeysValuesA', but using a 'Monad' since some people are
158   --- more comfortable with 'Monad's and not all 'Monad's are 'Applicative'.
159   -mapKeysValuesM :: Monad m
160   - => (keyIn -> m keyOut)
161   - -> (valIn -> m valOut)
162   - -> Object keyIn valIn
163   - -> m (Object keyOut valOut)
164   -mapKeysValuesM fk fv =
165   - let fk' = WrapMonad . fk
166   - fv' = WrapMonad . fv
167   - in unwrapMonad . mapKeysValuesA fk' fv'
168   -
169   --- | An error value returned when an unexpected node is encountered, eg you
170   --- were expecting a 'Scalar' and found a 'Mapping'.
171   -data ObjectExtractError =
172   - ExpectedScalar
173   - | ExpectedSequence
174   - | ExpectedMapping
175   - deriving (Typeable, Show)
176   -instance Exception ObjectExtractError
177   -
178   --- | Extra a scalar from the input, failing if the input is a sequence or
179   --- mapping.
180   -fromScalar :: MonadFailure ObjectExtractError m => Object k v -> m v
181   -fromScalar (Scalar s) = return s
182   -fromScalar _ = failure ExpectedScalar
183   -
184   --- | Extra a sequence from the input, failing if the input is a scalar or
185   --- mapping.
186   -fromSequence :: MonadFailure ObjectExtractError m
187   - => Object k v
188   - -> m [Object k v]
189   -fromSequence (Sequence s) = return s
190   -fromSequence _ = failure ExpectedSequence
191   -
192   --- | Extra a mapping from the input, failing if the input is a scalar or
193   --- sequence.
194   -fromMapping :: MonadFailure ObjectExtractError m
195   - => Object k v
196   - -> m [(k, Object k v)]
197   -fromMapping (Mapping m) = return m
198   -fromMapping _ = failure ExpectedMapping
199   -
200   --- | Something which can be converted from a to 'Object' k v with guaranteed
201   --- success. A somewhat unusual but very simple example would be:
202   ---
203   --- @
204   --- data TestScore = TestScore { name :: String, score :: Int }
205   --- instance ToObject [TestScore] String Int where
206   --- {- Explicit version, slightly tedious
207   --- toObject = Mapping . map (name &&& Scalar . score)
208   --- -}
209   --- {- Or, just let toObject figure it out for you! -}
210   --- toObject = toObject . map (name &&& score)
211   --- @
212   ---
213   --- Then toObject [TestScore \"Abe\" 5, TestScore \"Bill\" 2] would produce, in
214   --- JSON format, {\"Abe\":5,\"Bill\":2}.
215   ---
216   --- The purpose of showing these two versions of the implementation are to give
217   --- an idea of the power of 'toObject'. Since many basic instances of 'ToObject'
218   --- are included, you can often times avoid using the 'Object' constructors
219   --- directly and simply call 'toObject'.
220   ---
221   --- In the first version of the code, we explicitly convert each TestScore into a
222   --- (String, Object String Int); notice how we must use \"Scalar . score\". We
223   --- then need to wrap that whole structure into a 'Mapping' constructor.
224   ---
225   --- In the second version, we just convert each TestScore into a ('String',
226   --- 'Int') pair, then use a built-in instance of 'ToObject' to convert [(k, v)]
227   --- into Object k v.
228   ---
229   --- Please read the documentation on 'FromObject' to see how this same approach
230   --- is used on the reverse end of the conversion for an even more powerful
231   --- result.
232   ---
233   --- Minimal complete definition: 'toObject'.
234   -class ToObject a k v where
235   - toObject :: a -> Object k v
236   -
237   - listToObject :: [a] -> Object k v
238   - listToObject = Sequence . map toObject
239   -
240   - -- | This isn't useful for any of the instances we define here, but
241   - -- other users may find uses for it.
242   - mapToObject :: ConvertSuccess k' k => [(k', a)] -> Object k v
243   - mapToObject = Mapping . map (convertSuccess *** toObject)
244   -
245   --- | Something which can attempt a conversion from 'Object' k v to a with a
246   --- possibility of failure. To finish off with the example in 'ToObject':
247   ---
248   --- @
249   --- data TestScore = TestScore { name :: String, score :: Int }
250   --- instance FromObject [TestScore] String Int where
251   --- {- Verbose, simple version
252   --- fromObject o = do
253   --- objectPairs <- fromMapping o
254   --- pairs <- mapM getScalarFromSecond objectPairs
255   --- return $ map testScoreFromPair pairs
256   --- where
257   --- getScalarFromSecond :: (k, Object k v)
258   --- -> Attempt (k, v)
259   --- getScalarFromSecond (k, v) = do
260   --- v' <- fromScalar v
261   --- return (k, v')
262   --- testScoreFromPair :: (String, Int) -> TestScore
263   --- testScoreFromPair (n, s) = TestScore n s
264   --- -}
265   --- {- Complicated, short version
266   --- fromObject =
267   --- mapM (fmap (uncurry TestScore)
268   --- . runKleisli (second $ Kleisli `fromScalar`))
269   --- <=< `fromMapping`
270   --- -}
271   --- {- And this is just cheating -}
272   --- fromObject o = map (uncurry TestScore) \``fmap`\` fromObject o
273   --- @
274   ---
275   --- Hopefully this example demonstrates how powerful an idea fromObject can be.
276   --- In this example, there are two things that could cause problems with the
277   --- data:
278   ---
279   --- 1. The initial value may not be a 'Mapping'.
280   ---
281   --- 2. Given that it is a 'Mapping', one of its values may not be a 'Scalar'.
282   ---
283   --- Starting with the verbose version, we use 'getMapping' to ensure that we are
284   --- dealing with a 'Mapping' and 'getScalarFromSecond' to ensure that all values
285   --- in that 'Mapping' are in fact 'Scalar's. In the complicated version, we do
286   --- the exact same thing, instead using 'Kleisli' arrows to do the heavy lifting
287   --- in tuples.
288   ---
289   --- However, the \"cheating\" version simply (ab)uses the fact that there are
290   --- already instances of 'FromObject' to deal with conversion from 'Object' k v
291   --- to [(k, v)]. The only thing left is to convert those pairs into
292   --- 'TestScore's.
293   ---
294   --- Minimal complete definition: 'fromObject'.
295   -class FromObject a k v where
296   - fromObject :: Object k v -> Attempt a
297   -
298   - listFromObject :: Object k v -> Attempt [a]
299   - listFromObject = mapM fromObject <=< fromSequence
300   -
301   - -- | This isn't useful for any of the instances we define here, but
302   - -- other users may find uses for it.
303   - mapFromObject :: ConvertAttempt k k'
304   - => Object k v
305   - -> Attempt [(k', a)]
306   - mapFromObject =
307   - mapM (runKleisli (Kleisli convertAttempt *** Kleisli fromObject))
308   - <=< fromMapping
309   -
310   --- Object identity conversions
311   -instance ToObject (Object k v) k v where
312   - toObject = id
313   -instance FromObject (Object k v) k v where
314   - fromObject = return
315   -
316   --- The following code seems too generic and will probably lead to overlapping
317   --- instances. It has thus been commented out.
318   -{-
319   --- Converting between different types of Objects
320   -instance (ConvertSuccess k k', ConvertSuccess v v')
321   - => ToObject (Object k v) k' v' where
322   - toObject = mapKeysValues convertSuccess convertSuccess
323   -
324   -instance (ConvertAttempt k' k, ConvertAttempt v' v)
325   - => FromObject (Object k v) k' v' where
326   - fromObject = mapKeysValuesM convertAttempt convertAttempt
327   --}
328   -
329   --- Sequence
330   -instance ToObject a k v => ToObject [a] k v where
331   - toObject = listToObject
332   -instance FromObject a k v => FromObject [a] k v where
333   - fromObject = listFromObject
334   -
335   --- Mapping
336   -instance (ConvertSuccess k k', ToObject v k' v') => ToObject (k, v) k' v' where
337   - toObject = listToObject . return
338   - listToObject = Mapping . map (convertSuccess *** toObject)
339   -instance (ConvertAttempt k' k, FromObject v k' v') => FromObject (k, v) k' v' where
340   - fromObject o = do
341   - ms <- listFromObject o
342   - case ms of
343   - [m] -> return m
344   - _ -> failureString "fromObject of pair requires mapping of size 1"
345   - listFromObject =
346   - mapM (runKleisli (Kleisli convertAttempt *** Kleisli fromObject))
347   - <=< fromMapping
348   -
349   --- | Wraps any 'Exception' thrown during a 'fromObject' call.
350   -data FromObjectException = forall e. Exception e => FromObjectException e
351   - deriving Typeable
352   -instance Show FromObjectException where
353   - show (FromObjectException e) = "FromObjectException " ++ show e
354   -instance Exception FromObjectException
355   -
356   --- | Calls 'fromObject' and wraps any 'Exception's in a 'FromObjectException'.
357   -fromObjectWrap :: (FromObject x k y, MonadFailure FromObjectException m)
358   - => Object k y
359   - -> m x
360   -fromObjectWrap = attempt (failure . FromObjectException) return . fromObject
361   -
362   --- | An equivalent of 'lookup' to deal specifically with maps of 'Object's. In
363   --- particular, it will:
364   ---
365   --- 1. Automatically convert the lookup key as necesary. For example- assuming
366   --- you have the appropriate 'ConvertSuccess' instances, you could lookup an 'Int' in
367   --- a map that has 'String' keys.
368   ---
369   --- 2. Return the result in an 'Attempt', not 'Maybe'. This is especially useful
370   --- when creating 'FromObject' instances.
371   ---
372   --- 3. Show a more useful error message. Since this function requires the key to
373   --- be 'Show'able, the fail message states what key was not found.
374   ---
375   --- 4. Calls 'fromObject' automatically, so you get out the value type that you
376   --- want, not just an 'Object'.
377   -lookupObject :: ( ConvertSuccess k' k
378   - , FromObject o k v
379   - , Typeable k
380   - , Typeable v
381   - , Show k
382   - , Eq k
383   - )
384   - => k'
385   - -> [(k, Object k v)]
386   - -> Attempt o
387   -lookupObject key pairs = A.lookup (convertSuccess key) pairs >>= fromObject
388   -
389   --- $scalarToFromObject
390   --- Due to overlapping instances, we cannot automatically make all instances of
391   --- 'ConvertSuccess' instances of 'ToObject' (and same with
392   --- 'ConvertAttempt'/'FromObject'), even though the implementation is standard. Just
393   --- use the following functions whenever you declare 'ConvertSuccess'/'ConvertAttempt'
394   --- instance and you should be good.
395   -
396   --- | An appropriate 'toObject' function for any types x and y which have a
397   --- 'ConvertSuccess' x y instance.
398   -scalarToObject :: ConvertSuccess x y => x -> Object k y
399   -scalarToObject = Scalar . convertSuccess
  6 +import Data.Object.Base
400 7
401   --- | An appropriate 'fromObject' function for any types x and y which have a
402   --- 'ConvertAttempt' x y instance.
403   -scalarFromObject :: ConvertAttempt y x => Object k y -> Attempt x
404   -scalarFromObject = convertAttempt <=< fromScalar
  8 +import Data.Object.String ()
  9 +import Data.Object.Text ()
  10 +import Data.Object.Scalar ()
404 Data/Object/Base.hs
... ... @@ -0,0 +1,404 @@
  1 +{-# LANGUAGE MultiParamTypeClasses #-}
  2 +{-# LANGUAGE FlexibleInstances #-}
  3 +{-# LANGUAGE FlexibleContexts #-}
  4 +{-# LANGUAGE DeriveDataTypeable #-}
  5 +{-# LANGUAGE ExistentialQuantification #-}
  6 +---------------------------------------------------------
  7 +--
  8 +-- Module : Data.Object.Base
  9 +-- Copyright : Michael Snoyman
  10 +-- License : BSD3
  11 +--
  12 +-- Maintainer : Michael Snoyman <michael@snoyman.com>
  13 +-- Stability : Stable
  14 +-- Portability : portable
  15 +--
  16 +-- These objects show up in different places, eg JSON, Yaml.
  17 +-- By providing a representation in a separate repository,
  18 +-- other libraries can share a single representation of
  19 +-- these structures.
  20 +--
  21 +---------------------------------------------------------
  22 +
  23 +-- | The core of this package is the 'Object' data type, which is used for
  24 +-- handling scalars, sequences and mappings in a nested manner. This
  25 +-- is the same structure used in JSON or Yaml data.
  26 +--
  27 +-- The 'Object' data type is polymorphic in its keys and values. Submodules
  28 +-- within this package provide more concrete datatypes, such as a 'String'
  29 +-- 'Object' and a specialized scalar type.
  30 +--
  31 +-- Besides the 'Object' data type, there are utility functions and type classes
  32 +-- for converting objects around. Care has been taken to avoid any overloaded
  33 +-- instances for these type classes.
  34 +module Data.Object.Base
  35 + ( -- * Object data type
  36 + Object (..)
  37 + -- * Basic mapping of keys and values
  38 + , mapKeys
  39 + , mapValues
  40 + , mapKeysValues
  41 + , mapKeysValuesA
  42 + , mapKeysValuesM
  43 + -- * Extracting underlying values
  44 + , ObjectExtractError (..)
  45 + , fromScalar
  46 + , fromSequence
  47 + , fromMapping
  48 + -- * Higher level conversions
  49 + , ToObject (..)
  50 + , FromObject (..)
  51 + -- ** Wrapping 'FromObject'
  52 + , FromObjectException (..)
  53 + , fromObjectWrap
  54 + -- * Helper functions
  55 + , lookupObject
  56 + -- ** Scalar/Object conversions
  57 + -- $scalarToFromObject
  58 + , scalarToObject
  59 + , scalarFromObject
  60 + ) where
  61 +
  62 +import Control.Arrow
  63 +import Control.Applicative
  64 +import Control.Monad (ap, (<=<))
  65 +
  66 +import Prelude hiding (mapM, sequence)
  67 +
  68 +import Data.Foldable
  69 +import Data.Traversable
  70 +import Data.Monoid
  71 +
  72 +import Data.Generics
  73 +import qualified Safe.Failure as A
  74 +import Control.Exception (Exception)
  75 +import Data.Attempt
  76 +
  77 +import Data.Convertible.Text
  78 +
  79 +-- | Can represent nested values as scalars, sequences and mappings. A
  80 +-- sequence is synonymous with a list, while a mapping is synonymous with a
  81 +-- list of pairs.
  82 +--
  83 +-- Note that instances of standard library type classes for this data type
  84 +-- leave the key untouched while altering the value. For example, the 'Functor'
  85 +-- instance defines 'fmap' to be synonymous with 'mapValues'.
  86 +data Object key val =
  87 + Mapping [(key, Object key val)]
  88 + | Sequence [Object key val]
  89 + | Scalar val
  90 + deriving (Show, Eq, Data, Typeable)
  91 +
  92 +instance Functor (Object key) where
  93 + fmap = mapValues
  94 +
  95 +instance Foldable (Object key) where
  96 + foldMap f (Scalar v) = f v
  97 + foldMap f (Sequence vs) = mconcat $ map (foldMap f) vs
  98 + foldMap f (Mapping pairs) = mconcat $ map (foldMap f . snd) pairs
  99 +
  100 +instance Traversable (Object key) where
  101 + traverse f (Scalar v) = Scalar <$> f v
  102 + traverse f (Sequence vs) = Sequence <$> traverse (traverse f) vs
  103 + traverse f (Mapping pairs) =
  104 + Mapping <$> traverse (traverse' (traverse f)) pairs
  105 +
  106 +-- It would be nice if there were an "instance Traversable ((,) a)", but I
  107 +-- won't make an orphan instance simply for convenience. Instead:
  108 +traverse' :: Applicative f => (a -> f b) -> (x, a) -> f (x, b)
  109 +traverse' f (x, a) = (,) x <$> f a
  110 +
  111 +joinObj :: Object key (Object key scalar) -> Object key scalar
  112 +joinObj (Scalar x) = x
  113 +joinObj (Sequence xs) = Sequence (map joinObj xs)
  114 +joinObj (Mapping xs) = Mapping (map (second joinObj) xs)
  115 +
  116 +instance Monad (Object key) where
  117 + return = Scalar
  118 + x >>= f = joinObj . fmap f $ x
  119 +
  120 +instance Applicative (Object key) where
  121 + pure = Scalar
  122 + (<*>) = ap
  123 +
  124 +-- | Apply some conversion to the keys of an 'Object', leaving the values
  125 +-- unchanged.
  126 +mapKeys :: (keyIn -> keyOut) -> Object keyIn val -> Object keyOut val
  127 +mapKeys = flip mapKeysValues id
  128 +
  129 +-- | Apply some conversion to the values of an 'Object', leaving the keys
  130 +-- unchanged. This is equivalent to 'fmap'.
  131 +mapValues :: (valIn -> valOut) -> Object key valIn -> Object key valOut
  132 +mapValues = mapKeysValues id
  133 +
  134 +-- | Apply a conversion to both the keys and values of an 'Object'.
  135 +mapKeysValues :: (keyIn -> keyOut)
  136 + -> (valIn -> valOut)
  137 + -> Object keyIn valIn
  138 + -> Object keyOut valOut
  139 +mapKeysValues _ fv (Scalar v) = Scalar $ fv v
  140 +mapKeysValues fk fv (Sequence os)= Sequence $ map (mapKeysValues fk fv) os
  141 +mapKeysValues fk fv (Mapping pairs) =
  142 + Mapping $ map (fk *** mapKeysValues fk fv) pairs
  143 +
  144 +-- | Apply an 'Applicative' conversion to both the keys and values of an
  145 +-- 'Object'.
  146 +mapKeysValuesA :: Applicative f
  147 + => (keyIn -> f keyOut)
  148 + -> (valIn -> f valOut)
  149 + -> Object keyIn valIn
  150 + -> f (Object keyOut valOut)
  151 +mapKeysValuesA _ fv (Scalar v) = Scalar <$> fv v
  152 +mapKeysValuesA fk fv (Sequence os) =
  153 + Sequence <$> traverse (mapKeysValuesA fk fv) os
  154 +mapKeysValuesA fk fv (Mapping pairs) = Mapping <$>
  155 + traverse (uncurry (liftA2 (,)) . (fk *** mapKeysValuesA fk fv)) pairs
  156 +
  157 +-- | The same as 'mapKeysValuesA', but using a 'Monad' since some people are
  158 +-- more comfortable with 'Monad's and not all 'Monad's are 'Applicative'.
  159 +mapKeysValuesM :: Monad m
  160 + => (keyIn -> m keyOut)
  161 + -> (valIn -> m valOut)
  162 + -> Object keyIn valIn
  163 + -> m (Object keyOut valOut)
  164 +mapKeysValuesM fk fv =
  165 + let fk' = WrapMonad . fk
  166 + fv' = WrapMonad . fv
  167 + in unwrapMonad . mapKeysValuesA fk' fv'
  168 +
  169 +-- | An error value returned when an unexpected node is encountered, eg you
  170 +-- were expecting a 'Scalar' and found a 'Mapping'.
  171 +data ObjectExtractError =
  172 + ExpectedScalar
  173 + | ExpectedSequence
  174 + | ExpectedMapping
  175 + deriving (Typeable, Show)
  176 +instance Exception ObjectExtractError
  177 +
  178 +-- | Extra a scalar from the input, failing if the input is a sequence or
  179 +-- mapping.
  180 +fromScalar :: MonadFailure ObjectExtractError m => Object k v -> m v
  181 +fromScalar (Scalar s) = return s
  182 +fromScalar _ = failure ExpectedScalar
  183 +
  184 +-- | Extra a sequence from the input, failing if the input is a scalar or
  185 +-- mapping.
  186 +fromSequence :: MonadFailure ObjectExtractError m
  187 + => Object k v
  188 + -> m [Object k v]
  189 +fromSequence (Sequence s) = return s
  190 +fromSequence _ = failure ExpectedSequence
  191 +
  192 +-- | Extra a mapping from the input, failing if the input is a scalar or
  193 +-- sequence.
  194 +fromMapping :: MonadFailure ObjectExtractError m
  195 + => Object k v
  196 + -> m [(k, Object k v)]
  197 +fromMapping (Mapping m) = return m
  198 +fromMapping _ = failure ExpectedMapping
  199 +
  200 +-- | Something which can be converted from a to 'Object' k v with guaranteed
  201 +-- success. A somewhat unusual but very simple example would be:
  202 +--
  203 +-- @
  204 +-- data TestScore = TestScore { name :: String, score :: Int }
  205 +-- instance ToObject [TestScore] String Int where
  206 +-- {- Explicit version, slightly tedious
  207 +-- toObject = Mapping . map (name &&& Scalar . score)
  208 +-- -}
  209 +-- {- Or, just let toObject figure it out for you! -}
  210 +-- toObject = toObject . map (name &&& score)
  211 +-- @
  212 +--
  213 +-- Then toObject [TestScore \"Abe\" 5, TestScore \"Bill\" 2] would produce, in
  214 +-- JSON format, {\"Abe\":5,\"Bill\":2}.
  215 +--
  216 +-- The purpose of showing these two versions of the implementation are to give
  217 +-- an idea of the power of 'toObject'. Since many basic instances of 'ToObject'
  218 +-- are included, you can often times avoid using the 'Object' constructors
  219 +-- directly and simply call 'toObject'.
  220 +--
  221 +-- In the first version of the code, we explicitly convert each TestScore into a
  222 +-- (String, Object String Int); notice how we must use \"Scalar . score\". We
  223 +-- then need to wrap that whole structure into a 'Mapping' constructor.
  224 +--
  225 +-- In the second version, we just convert each TestScore into a ('String',
  226 +-- 'Int') pair, then use a built-in instance of 'ToObject' to convert [(k, v)]
  227 +-- into Object k v.
  228 +--
  229 +-- Please read the documentation on 'FromObject' to see how this same approach
  230 +-- is used on the reverse end of the conversion for an even more powerful
  231 +-- result.
  232 +--
  233 +-- Minimal complete definition: 'toObject'.
  234 +class ToObject a k v where
  235 + toObject :: a -> Object k v
  236 +
  237 + listToObject :: [a] -> Object k v
  238 + listToObject = Sequence . map toObject
  239 +
  240 + -- | This isn't useful for any of the instances we define here, but
  241 + -- other users may find uses for it.
  242 + mapToObject :: ConvertSuccess k' k => [(k', a)] -> Object k v
  243 + mapToObject = Mapping . map (convertSuccess *** toObject)
  244 +
  245 +-- | Something which can attempt a conversion from 'Object' k v to a with a
  246 +-- possibility of failure. To finish off with the example in 'ToObject':
  247 +--
  248 +-- @
  249 +-- data TestScore = TestScore { name :: String, score :: Int }
  250 +-- instance FromObject [TestScore] String Int where
  251 +-- {- Verbose, simple version
  252 +-- fromObject o = do
  253 +-- objectPairs <- fromMapping o
  254 +-- pairs <- mapM getScalarFromSecond objectPairs
  255 +-- return $ map testScoreFromPair pairs
  256 +-- where
  257 +-- getScalarFromSecond :: (k, Object k v)
  258 +-- -> Attempt (k, v)
  259 +-- getScalarFromSecond (k, v) = do
  260 +-- v' <- fromScalar v
  261 +-- return (k, v')
  262 +-- testScoreFromPair :: (String, Int) -> TestScore
  263 +-- testScoreFromPair (n, s) = TestScore n s
  264 +-- -}
  265 +-- {- Complicated, short version
  266 +-- fromObject =
  267 +-- mapM (fmap (uncurry TestScore)
  268 +-- . runKleisli (second $ Kleisli `fromScalar`))
  269 +-- <=< `fromMapping`
  270 +-- -}
  271 +-- {- And this is just cheating -}
  272 +-- fromObject o = map (uncurry TestScore) \``fmap`\` fromObject o
  273 +-- @
  274 +--
  275 +-- Hopefully this example demonstrates how powerful an idea fromObject can be.
  276 +-- In this example, there are two things that could cause problems with the
  277 +-- data:
  278 +--
  279 +-- 1. The initial value may not be a 'Mapping'.
  280 +--
  281 +-- 2. Given that it is a 'Mapping', one of its values may not be a 'Scalar'.
  282 +--
  283 +-- Starting with the verbose version, we use 'getMapping' to ensure that we are
  284 +-- dealing with a 'Mapping' and 'getScalarFromSecond' to ensure that all values
  285 +-- in that 'Mapping' are in fact 'Scalar's. In the complicated version, we do
  286 +-- the exact same thing, instead using 'Kleisli' arrows to do the heavy lifting
  287 +-- in tuples.
  288 +--
  289 +-- However, the \"cheating\" version simply (ab)uses the fact that there are
  290 +-- already instances of 'FromObject' to deal with conversion from 'Object' k v
  291 +-- to [(k, v)]. The only thing left is to convert those pairs into
  292 +-- 'TestScore's.
  293 +--
  294 +-- Minimal complete definition: 'fromObject'.
  295 +class FromObject a k v where
  296 + fromObject :: Object k v -> Attempt a
  297 +
  298 + listFromObject :: Object k v -> Attempt [a]
  299 + listFromObject = mapM fromObject <=< fromSequence
  300 +
  301 + -- | This isn't useful for any of the instances we define here, but
  302 + -- other users may find uses for it.
  303 + mapFromObject :: ConvertAttempt k k'
  304 + => Object k v
  305 + -> Attempt [(k', a)]
  306 + mapFromObject =
  307 + mapM (runKleisli (Kleisli convertAttempt *** Kleisli fromObject))
  308 + <=< fromMapping
  309 +
  310 +-- Object identity conversions
  311 +instance ToObject (Object k v) k v where
  312 + toObject = id
  313 +instance FromObject (Object k v) k v where
  314 + fromObject = return
  315 +
  316 +-- The following code seems too generic and will probably lead to overlapping
  317 +-- instances. It has thus been commented out.
  318 +{-
  319 +-- Converting between different types of Objects
  320 +instance (ConvertSuccess k k', ConvertSuccess v v')
  321 + => ToObject (Object k v) k' v' where
  322 + toObject = mapKeysValues convertSuccess convertSuccess
  323 +
  324 +instance (ConvertAttempt k' k, ConvertAttempt v' v)
  325 + => FromObject (Object k v) k' v' where
  326 + fromObject = mapKeysValuesM convertAttempt convertAttempt
  327 +-}
  328 +
  329 +-- Sequence
  330 +instance ToObject a k v => ToObject [a] k v where
  331 + toObject = listToObject
  332 +instance FromObject a k v => FromObject [a] k v where
  333 + fromObject = listFromObject
  334 +
  335 +-- Mapping
  336 +instance (ConvertSuccess k k', ToObject v k' v') => ToObject (k, v) k' v' where
  337 + toObject = listToObject . return
  338 + listToObject = Mapping . map (convertSuccess *** toObject)
  339 +instance (ConvertAttempt k' k, FromObject v k' v') => FromObject (k, v) k' v' where
  340 + fromObject o = do
  341 + ms <- listFromObject o
  342 + case ms of
  343 + [m] -> return m
  344 + _ -> failureString "fromObject of pair requires mapping of size 1"
  345 + listFromObject =
  346 + mapM (runKleisli (Kleisli convertAttempt *** Kleisli fromObject))
  347 + <=< fromMapping
  348 +
  349 +-- | Wraps any 'Exception' thrown during a 'fromObject' call.
  350 +data FromObjectException = forall e. Exception e => FromObjectException e
  351 + deriving Typeable
  352 +instance Show FromObjectException where
  353 + show (FromObjectException e) = "FromObjectException " ++ show e
  354 +instance Exception FromObjectException
  355 +
  356 +-- | Calls 'fromObject' and wraps any 'Exception's in a 'FromObjectException'.
  357 +fromObjectWrap :: (FromObject x k y, MonadFailure FromObjectException m)
  358 + => Object k y
  359 + -> m x
  360 +fromObjectWrap = attempt (failure . FromObjectException) return . fromObject
  361 +
  362 +-- | An equivalent of 'lookup' to deal specifically with maps of 'Object's. In
  363 +-- particular, it will:
  364 +--
  365 +-- 1. Automatically convert the lookup key as necesary. For example- assuming
  366 +-- you have the appropriate 'ConvertSuccess' instances, you could lookup an 'Int' in
  367 +-- a map that has 'String' keys.
  368 +--
  369 +-- 2. Return the result in an 'Attempt', not 'Maybe'. This is especially useful
  370 +-- when creating 'FromObject' instances.
  371 +--
  372 +-- 3. Show a more useful error message. Since this function requires the key to
  373 +-- be 'Show'able, the fail message states what key was not found.
  374 +--
  375 +-- 4. Calls 'fromObject' automatically, so you get out the value type that you
  376 +-- want, not just an 'Object'.
  377 +lookupObject :: ( ConvertSuccess k' k
  378 + , FromObject o k v
  379 + , Typeable k
  380 + , Typeable v
  381 + , Show k
  382 + , Eq k
  383 + )
  384 + => k'
  385 + -> [(k, Object k v)]
  386 + -> Attempt o
  387 +lookupObject key pairs = A.lookup (convertSuccess key) pairs >>= fromObject
  388 +
  389 +-- $scalarToFromObject
  390 +-- Due to overlapping instances, we cannot automatically make all instances of
  391 +-- 'ConvertSuccess' instances of 'ToObject' (and same with
  392 +-- 'ConvertAttempt'/'FromObject'), even though the implementation is standard. Just
  393 +-- use the following functions whenever you declare 'ConvertSuccess'/'ConvertAttempt'
  394 +-- instance and you should be good.
  395 +
  396 +-- | An appropriate 'toObject' function for any types x and y which have a
  397 +-- 'ConvertSuccess' x y instance.
  398 +scalarToObject :: ConvertSuccess x y => x -> Object k y
  399 +scalarToObject = Scalar . convertSuccess
  400 +
  401 +-- | An appropriate 'fromObject' function for any types x and y which have a
  402 +-- 'ConvertAttempt' x y instance.
  403 +scalarFromObject :: ConvertAttempt y x => Object k y -> Attempt x
  404 +scalarFromObject = convertAttempt <=< fromScalar
6 Data/Object/Scalar.hs
@@ -16,13 +16,13 @@ module Data.Object.Scalar
16 16 , ScalarObject
17 17 , toScalarObject
18 18 , fromScalarObject
  19 + , module Data.Object.Base
19 20 ) where
20 21
21 22 import Data.ByteString.Lazy (ByteString, empty)
22   -import Data.Text.Lazy (Text)
23 23 import Data.Time.Clock (UTCTime)
24   -import Data.Object
25   -import Data.Object.Text ()
  24 +import Data.Object.Text
  25 +import Data.Object.Base
26 26 import System.Locale (defaultTimeLocale)
27 27 import Data.Time.Format (formatTime)
28 28 import Data.Attempt
5 Data/Object/String.hs
@@ -19,10 +19,11 @@ module Data.Object.String
19 19 ( StringObject
20 20 , toStringObject
21 21 , fromStringObject
  22 + , module Data.Object.Base
22 23 ) where
23 24
24   -import Data.Object
25   -import Data.Object.Text (ExpectedCharException (..))
  25 +import Data.Object.Base
  26 +import Data.Object.Text
26 27 import Data.Attempt
27 28 import Control.Monad ((<=<))
28 29
3  Data/Object/Text.hs
@@ -21,9 +21,10 @@ module Data.Object.Text
21 21 , fromTextObject
22 22 , Text
23 23 , ExpectedCharException (..)
  24 + , module Data.Object.Base
24 25 ) where
25 26
26   -import Data.Object
  27 +import Data.Object.Base
27 28 import Data.Text.Lazy (Text)
28 29 import Data.Attempt
29 30
1  data-object.cabal
@@ -34,6 +34,7 @@ library
34 34 attempt >= 0.2.0 && < 0.3,
35 35 convertible-text >= 0.0.0 && < 0.1
36 36 exposed-modules: Data.Object
  37 + Data.Object.Base
37 38 Data.Object.Text
38 39 Data.Object.Scalar
39 40 Data.Object.String

0 comments on commit 5f64bfd

Please sign in to comment.
Something went wrong with that request. Please try again.