data-object 0.0.2 → 0.2.0

raw patch · 9 files changed

+670/−172 lines, 9 filesdep +HUnitdep +QuickCheckdep +attemptdep −bytestring-classdep −safedep ~timesetup-changednew-component:exe:runtestsPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, QuickCheck, attempt, convertible-text, old-locale, safe-failure, syb, template-haskell, test-framework, test-framework-hunit, test-framework-quickcheck, text

Dependencies removed: bytestring-class, safe

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• Data/Object.hs +6/−164
• Data/Object/Base.hs +348/−0
• Data/Object/Scalar.hs +65/−0
• Data/Object/String.hs +46/−0
• Data/Object/Text.hs +146/−0
• LICENSE +1/−1
• Setup.lhs +5/−1
• data-object.cabal +41/−6
• runtests.hs +12/−0

@@ -1,168 +1,10 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE OverlappingInstances #-}---------------------------------------------------------------- Module        : Data.Object--- Copyright     : Michael Snoyman--- License       : BSD3------ Maintainer    : Michael Snoyman <michael@snoyman.com>--- Stability     : Stable--- Portability   : portable------ These objects show up in different places, eg JSON, Yaml.--- By providing a representation in a separate repository,--- other libraries can share a single representation of--- these structures.-------------------------------------------------------------+-- | Imports all instances provided in this package. module Data.Object-    ( Object-    , GenObject (..)-    , FromObject (..)-    , ToObject (..)-    , FromScalar (..)-    , ToScalar (..)-    , oLookup+    ( module Data.Object.Base     ) where -import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString as BS-import Data.ByteString.Class-import Control.Arrow-import Data.Time.Calendar-import Safe (readMay)--data GenObject key val =-    Mapping [(key, GenObject key val)]-    | Sequence [GenObject key val]-    | Scalar val-    deriving (Show)--type Object = GenObject B.ByteString B.ByteString--class ToObject a where-    toObject :: a -> Object-class FromObject a where-    fromObject :: Monad m => Object -> m a--class ToObject a => ToScalar a where-    toScalar :: a -> B.ByteString-class FromObject a => FromScalar a where-    fromScalar :: Monad m => B.ByteString -> m a--bsFromObject :: Monad m => Object -> m B.ByteString-bsFromObject (Scalar s) = return s-bsFromObject _ = fail "Attempt to extract a scalar from non-scalar"--instance ToScalar B.ByteString where-    toScalar = id-instance FromScalar B.ByteString where-    fromScalar = return-instance ToObject B.ByteString where-    toObject = Scalar-instance FromObject B.ByteString where-    fromObject = bsFromObject--instance ToScalar BS.ByteString where-    toScalar = toLazyByteString-instance FromScalar BS.ByteString where-    fromScalar = return . fromLazyByteString-instance ToObject BS.ByteString where-    toObject = Scalar . toScalar-instance FromObject BS.ByteString where-    fromObject o = fromObject o >>= fromScalar--instance ToScalar String where-    toScalar = toLazyByteString-instance FromScalar String where-    fromScalar = return . fromLazyByteString-instance ToObject String where-    toObject = Scalar . toScalar-instance FromObject String where-    fromObject o = fromObject o >>= fromScalar--instance ToObject o => ToObject [o] where-    toObject = Sequence . map toObject--instance FromObject o => FromObject [o] where-    fromObject (Sequence os) = mapM fromObject os-    fromObject _ = fail "Attempt to extract a sequence from non-sequence"--instance (ToScalar bs, ToObject o) => ToObject [(bs, o)] where-    toObject = Mapping . map (toScalar *** toObject)--instance (FromScalar bs, FromObject o) => FromObject [(bs, o)] where-    fromObject (Mapping pairs) =-        mapM (liftPair . (fromScalar *** fromObject)) pairs-    fromObject _ = fail "Attempt to extract a mapping from non-mapping"--instance ToObject Object where-    toObject = id--instance FromObject Object where-    fromObject = return--liftPair :: Monad m => (m a, m b) -> m (a, b)-liftPair (a, b) = do-    a' <- a-    b' <- b-    return (a', b')--oLookup :: (Monad m, Eq a, Show a, FromObject b)-        => a -- ^ key-        -> [(a, Object)]-        -> m b-oLookup key pairs =-    case lookup key pairs of-        Nothing -> fail $ "Key not found: " ++ show key-        Just x -> fromObject x---- instances--instance ToScalar Day where-    toScalar = toLazyByteString . show-instance ToObject Day where-    toObject = toObject . toScalar-instance FromScalar Day where-    fromScalar bs = do-        let s = fromLazyByteString bs-        if length s /= 10-            then fail ("Invalid day: " ++ s)-            else do-                let x = do-                    y' <- readMay $ take 4 s-                    m' <- readMay $ take 2 $ drop 5 s-                    d' <- readMay $ take 2 $ drop 8 s-                    return (y', m', d')-                case x of-                    Just (y, m, d) -> return $ fromGregorian y m d-                    Nothing -> fail $ "Invalid day: " ++ s-instance FromObject Day where-    fromObject o = fromObject o >>= fromScalar--instance ToScalar Bool where-    toScalar b = toScalar $ if b then "true" else "false"-instance ToObject Bool where-    toObject = toObject . toScalar-instance FromScalar Bool where-    fromScalar bs =-        case fromLazyByteString bs of-            "true" -> return True-            "false" -> return False-            x -> fail $ "Invalid bool value: " ++ x-instance FromObject Bool where-    fromObject o = fromObject o >>= fromScalar+import Data.Object.Base -instance ToScalar Int where-    toScalar = toScalar . show-instance ToObject Int where-    toObject = toObject . toScalar-instance FromScalar Int where-    fromScalar bs =-        case readMay $ fromLazyByteString bs of-            Nothing -> fail $ "Invalid integer: " ++ fromLazyByteString bs-            Just i -> return i-instance FromObject Int where-    fromObject o = fromObject o >>= fromScalar+import Data.Object.String ()+import Data.Object.Text ()+import Data.Object.Scalar ()

@@ -0,0 +1,348 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TemplateHaskell #-}+---------------------------------------------------------+--+-- Module        : Data.Object.Base+-- Copyright     : Michael Snoyman+-- License       : BSD3+--+-- Maintainer    : Michael Snoyman <michael@snoyman.com>+-- Stability     : Stable+-- Portability   : portable+--+-- These objects show up in different places, eg JSON, Yaml.+-- By providing a representation in a separate repository,+-- other libraries can share a single representation of+-- these structures.+--+---------------------------------------------------------++-- | The core of this package is the 'Object' data type, which is used for+-- handling scalars, sequences and mappings in a nested manner. This+-- is the same structure used in JSON or Yaml data.+--+-- The 'Object' data type is polymorphic in its keys and values. Submodules+-- within this package provide more concrete datatypes, such as a 'String'+-- 'Object' and a specialized scalar type.+--+-- Besides the 'Object' data type, there are utility functions and type classes+-- for converting objects around. Care has been taken to avoid any overloaded+-- instances for these type classes.+module Data.Object.Base+    ( -- * Object data type+      Object (..)+      -- * Basic mapping of keys and values+    , mapKeys+    , mapValues+    , mapKeysValues+    , mapKeysValuesA+    , mapKeysValuesM+      -- * Convert entires objects+    , convertObject+    , convertObjectM+      -- * Extracting underlying values+    , ObjectExtractError (..)+    , fromScalar+    , fromSequence+    , fromMapping+      -- * Common object conversions+    , sTO+    , sFO+    , lTO+    , lFO+    , mTO+    , mFO+    , olTO+    , olFO+    , omTO+    , omFO+      -- * Automatic deriving of instances+    , deriveSuccessConvs+      -- * Helper functions+    , lookupObject+      -- * Re-export+    , module Data.Convertible.Text+    ) where++import Control.Arrow+import Control.Applicative+import Control.Monad (ap, (<=<))++import Prelude hiding (mapM, sequence)++import Data.Foldable hiding (concatMap, concat)+import Data.Traversable+import Data.Monoid++import Data.Generics+import qualified Safe.Failure as A+import Control.Exception (Exception)+import Data.Attempt++import Data.Convertible.Text+import Language.Haskell.TH++-- | Can represent nested values as scalars, sequences and mappings.  A+-- sequence is synonymous with a list, while a mapping is synonymous with a+-- list of pairs.+--+-- Note that instances of standard library type classes for this data type+-- leave the key untouched while altering the value. For example, the 'Functor'+-- instance defines 'fmap' to be synonymous with 'mapValues'.+data Object key val =+    Mapping [(key, Object key val)]+    | Sequence [Object key val]+    | Scalar val+    deriving (Show, Eq, Data, Typeable)++instance Functor (Object key) where+    fmap = mapValues++instance Foldable (Object key) where+    foldMap f (Scalar v) = f v+    foldMap f (Sequence vs) = mconcat $ map (foldMap f) vs+    foldMap f (Mapping pairs) = mconcat $ map (foldMap f . snd) pairs++instance Traversable (Object key) where+    traverse f (Scalar v) = Scalar <$> f v+    traverse f (Sequence vs) = Sequence <$> traverse (traverse f) vs+    traverse f (Mapping pairs) =+      Mapping <$> traverse (traverse' (traverse f)) pairs++-- It would be nice if there were an "instance Traversable ((,) a)", but I+-- won't make an orphan instance simply for convenience. Instead:+traverse' :: Applicative f => (a -> f b) -> (x, a) -> f (x, b)+traverse' f (x, a) = (,) x <$> f a++joinObj :: Object key (Object key scalar) -> Object key scalar+joinObj (Scalar x)    = x+joinObj (Sequence xs) = Sequence (map joinObj xs)+joinObj (Mapping  xs) = Mapping  (map (second joinObj) xs)++instance Monad (Object key) where+    return = Scalar+    x >>= f = joinObj . fmap f $ x++instance Applicative (Object key) where+    pure  = Scalar+    (<*>) = ap++-- | Apply some conversion to the keys of an 'Object', leaving the values+-- unchanged.+mapKeys :: (keyIn -> keyOut) -> Object keyIn val -> Object keyOut val+mapKeys = flip mapKeysValues id++-- | Apply some conversion to the values of an 'Object', leaving the keys+-- unchanged. This is equivalent to 'fmap'.+mapValues :: (valIn -> valOut) -> Object key valIn -> Object key valOut+mapValues = mapKeysValues id++-- | Apply a conversion to both the keys and values of an 'Object'.+mapKeysValues :: (keyIn -> keyOut)+              -> (valIn -> valOut)+              -> Object keyIn valIn+              -> Object keyOut valOut+mapKeysValues _ fv (Scalar v) = Scalar $ fv v+mapKeysValues fk fv (Sequence os)= Sequence $ map (mapKeysValues fk fv) os+mapKeysValues fk fv (Mapping pairs) =+    Mapping $ map (fk *** mapKeysValues fk fv) pairs++-- | Apply an 'Applicative' conversion to both the keys and values of an+-- 'Object'.+mapKeysValuesA :: Applicative f+               => (keyIn -> f keyOut)+               -> (valIn -> f valOut)+               -> Object keyIn valIn+               -> f (Object keyOut valOut)+mapKeysValuesA _ fv (Scalar v) = Scalar <$> fv v+mapKeysValuesA fk fv (Sequence os) =+    Sequence <$> traverse (mapKeysValuesA fk fv) os+mapKeysValuesA fk fv (Mapping pairs) = Mapping <$>+    traverse (uncurry (liftA2 (,)) . (fk *** mapKeysValuesA fk fv)) pairs++-- | The same as 'mapKeysValuesA', but using a 'Monad' since some people are+-- more comfortable with 'Monad's and not all 'Monad's are 'Applicative'.+mapKeysValuesM :: Monad m+               => (keyIn -> m keyOut)+               -> (valIn -> m valOut)+               -> Object keyIn valIn+               -> m (Object keyOut valOut)+mapKeysValuesM fk fv =+    let fk' = WrapMonad . fk+        fv' = WrapMonad . fv+     in unwrapMonad . mapKeysValuesA fk' fv'++convertObject :: (ConvertSuccess k k', ConvertSuccess v v')+              => Object k v+              -> Object k' v'+convertObject = mapKeysValues cs cs++convertObjectM :: (ConvertAttempt k k', ConvertAttempt v v')+               => Object k v+               -> Attempt (Object k' v')+convertObjectM = mapKeysValuesM ca ca++-- | An error value returned when an unexpected node is encountered, eg you+-- were expecting a 'Scalar' and found a 'Mapping'.+data ObjectExtractError =+    ExpectedScalar+    | ExpectedSequence+    | ExpectedMapping+    deriving (Typeable, Show)+instance Exception ObjectExtractError++-- | Extra a scalar from the input, failing if the input is a sequence or+-- mapping.+fromScalar :: MonadFailure ObjectExtractError m => Object k v -> m v+fromScalar (Scalar s) = return s+fromScalar _ = failure ExpectedScalar++-- | Extra a sequence from the input, failing if the input is a scalar or+-- mapping.+fromSequence :: MonadFailure ObjectExtractError m+             => Object k v+             -> m [Object k v]+fromSequence (Sequence s) = return s+fromSequence _ = failure ExpectedSequence++-- | Extra a mapping from the input, failing if the input is a scalar or+-- sequence.+fromMapping :: MonadFailure ObjectExtractError m+            => Object k v+            -> m [(k, Object k v)]+fromMapping (Mapping m) = return m+fromMapping _ = failure ExpectedMapping++sTO :: ConvertSuccess v v' => v -> Object k v'+sTO = Scalar . cs++sFO :: ConvertAttempt v' v => Object k v' -> Attempt v+sFO = ca <=< fromScalar++lTO :: ConvertSuccess v v' => [v] -> Object k v'+lTO = Sequence . map (Scalar . cs)++lFO :: ConvertAttempt v' v => Object k v' -> Attempt [v]+lFO = mapM (ca <=< fromScalar) <=< fromSequence++mTO :: (ConvertSuccess k k', ConvertSuccess v v')+                => [(k, v)]+                -> Object k' v'+mTO = Mapping . map (cs *** Scalar . cs)++mFO :: (ConvertAttempt k' k, ConvertAttempt v' v)+                  => Object k' v'+                  -> Attempt [(k, v)]+mFO =+    mapM (runKleisli (Kleisli ca *** Kleisli sFO))+ <=< fromMapping++olTO :: ConvertSuccess x (Object k v) => [x] -> Object k v+olTO = Sequence . map cs++olFO :: ConvertAttempt (Object k v) x => Object k v -> Attempt [x]+olFO = mapM ca <=< fromSequence++omTO :: (ConvertSuccess k' k, ConvertSuccess x (Object k v))+                 => [(k', x)]+                 -> Object k v+omTO = Mapping . map (cs *** cs)++omFO :: (ConvertAttempt k k', ConvertAttempt (Object k v) x)+                   => Object k v+                   -> Attempt [(k', x)]+omFO = mapM (runKleisli (Kleisli ca *** Kleisli ca)) <=< fromMapping++deriveSuccessConvs :: Name -- ^ dest key+                   -> Name -- ^ dest value+                   -> [Name] -- ^ source keys+                   -> [Name] -- ^ source values+                   -> Q [Dec]+deriveSuccessConvs dk dv sks svs = do+    sto <- [|sTO|]+    sfo <- [|sFO|]+    lto <- [|lTO|]+    lfo <- [|lFO|]+    mto <- [|mTO|]+    mfo <- [|mFO|]+    olto <- [|olTO|]+    olfo <- [|olFO|]+    omto <- [|omTO|]+    omfo <- [|omFO|]+    co <- [|convertObject|]+    coa <- [|convertObjectM|]+    let sks' = map ConT sks+        svs' = map ConT svs+        pairs = do+            sk <- sks'+            sv <- svs'+            return (sk, sv)+    let valOnly = concatMap (helper1 sto sfo lto lfo) svs'+        both = concatMap (helper2 mto mfo olto olfo co coa omto omfo) pairs+        keyOnly = concatMap (helper3 omto omfo) sks'+    return $ valOnly ++ both ++ keyOnly+      where+        dk' = ConT dk+        dv' = ConT dv+        objectt k v = ConT (mkName "Object") `AppT` k `AppT` v+        to' src = ConT (mkName "ConvertSuccess") `AppT` src `AppT`+                  objectt dk' dv'+        fo' dst = ConT (mkName "ConvertAttempt") `AppT`+                  objectt dk' dv' `AppT` dst+        cs' = mkName "convertSuccess"+        ca' = mkName "convertAttempt"+        to src f =+            InstanceD [] (to' src) [FunD cs' [Clause [] (NormalB f) []]]+        fo dst f =+            InstanceD [] (fo' dst) [FunD ca' [Clause [] (NormalB f) []]]+        tofo ty x y = [to ty x, fo ty y]+        listt = AppT ListT+        pairt k v = TupleT 2 `AppT` k `AppT` v+        helper1 sto sfo lto lfo sv = concat+            [ tofo sv sto sfo+            , tofo (listt sv) lto lfo+            ]+        helper2 mto mfo olto olfo co coa omto omfo (sk, sv) = concat+            [ tofo (listt $ pairt sk sv) mto mfo+            , tofo (listt $ objectt sk sv) olto olfo+            , if sk == dk' && sv == dv' -- avoid overlapping with identity+                then []+                else tofo (objectt sk sv) co coa+            , if sk == dk' && sv == dv' -- avoid overlapping with helper3+                then []+                else tofo (listt $ pairt sk $ objectt sk sv) omto omfo+            ]+        helper3 omto omfo sk = concat+            [ tofo (listt $ pairt sk $ objectt dk' dv') omto omfo+            ]++-- | An equivalent of 'lookup' to deal specifically with maps of 'Object's. In+-- particular, it will:+--+-- 1. Automatically convert the lookup key as necesary. For example- assuming+-- you have the appropriate 'ConvertSuccess' instances, you could lookup an 'Int' in+-- a map that has 'String' keys.+--+-- 2. Return the result in an 'Attempt', not 'Maybe'. This is especially useful+-- when creating 'FromObject' instances.+--+-- 3. Show a more useful error message. Since this function requires the key to+-- be 'Show'able, the fail message states what key was not found.+--+-- 4. Calls 'fromObject' automatically, so you get out the value type that you+-- want, not just an 'Object'.+lookupObject :: ( ConvertSuccess k' k+                , ConvertAttempt (Object k v) o+                , Typeable k+                , Typeable v+                , Show k+                , Eq k+                )+             => k'+             -> [(k, Object k v)]+             -> Attempt o+lookupObject key = ca <=< A.lookup (convertSuccess key)

@@ -0,0 +1,65 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+---------------------------------------------------------+--+-- Module        : Data.Object.Scalar+-- Copyright     : Michael Snoyman+-- License       : BSD3+--+-- Maintainer    : Michael Snoyman <michael@snoyman.com>+-- Stability     : Stable+-- Portability   : portable+---------------------------------------------------------+module Data.Object.Scalar+    ( Scalar (..)+    , ScalarObject+    , toScalarObject+    , fromScalarObject+    , module Data.Object.Base+    ) where++import Data.ByteString.Lazy (ByteString, empty)+import Data.Time.Clock (UTCTime)+import Data.Object.Text+import Data.Object.Base+import System.Locale (defaultTimeLocale)+import Data.Time.Format (formatTime)+import Data.Attempt+import Data.Convertible.Text++data Scalar = Numeric   Rational+            | Text      Text+            | Binary    ByteString+            | Bool      Bool+            | Timestamp UTCTime+            | Null++type ScalarObject = Object String Scalar++instance ConvertSuccess Scalar Text where+    convertSuccess (Numeric n) = convertSuccess $ show n+    convertSuccess (Text t) = t+    convertSuccess (Binary b) = convertSuccess b+    convertSuccess (Bool True) = convertSuccess "true"+    convertSuccess (Bool False) = convertSuccess "false"+    -- this is W3 format for timestamps.+    convertSuccess (Timestamp t) =+        convertSuccess $ formatTime defaultTimeLocale "%FT%XZ" t+    convertSuccess Null = convertSuccess empty++{- FIXME write a real conversion here+instance ConvertSuccess Text Scalar where+    convertSuccess = Text+-}++-- | 'toObject' specialized for 'ScalarObject's+toScalarObject :: ConvertSuccess a ScalarObject => a -> ScalarObject+toScalarObject = cs++-- | 'fromObject' specialized for 'ScalarObject's+fromScalarObject :: ConvertAttempt ScalarObject a+                 => ScalarObject+                 -> Attempt a+fromScalarObject = ca

@@ -0,0 +1,46 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+---------------------------------------------------------+--+-- Module        : Data.Object.String+-- Copyright     : Michael Snoyman+-- License       : BSD3+--+-- Maintainer    : Michael Snoyman <michael@snoyman.com>+-- Stability     : Stable+-- Portability   : portable+--+-- Objects with 'String's for keys and values.+---------------------------------------------------------++module Data.Object.String+    ( StringObject+    , toStringObject+    , fromStringObject+    , module Data.Object.Base+    ) where++import Data.Object.Base+import Data.Attempt++import Data.Time.Calendar++type StringObject = Object String String++-- | 'toObject' specialized for 'StringObject's+toStringObject :: ConvertSuccess a StringObject => a -> StringObject+toStringObject = cs++-- | 'fromObject' specialized for 'StringObject's+fromStringObject :: ConvertAttempt StringObject a+                 => StringObject+                 -> Attempt a+fromStringObject = ca++$(deriveSuccessConvs ''String ''String+    [''String]+    [''String, ''Day, ''Int, ''Rational, ''Bool])

@@ -0,0 +1,146 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+---------------------------------------------------------+--+-- Module        : Data.Object.Text+-- Copyright     : Michael Snoyman+-- License       : BSD3+--+-- Maintainer    : Michael Snoyman <michael@snoyman.com>+-- Stability     : Stable+-- Portability   : portable+---------------------------------------------------------++-- | Keys and values are lazy 'Text's.+module Data.Object.Text+    ( TextObject+    , toTextObject+    , fromTextObject+    , Text+    , module Data.Object.Base+#if TEST+    , testSuite+#endif+    ) where++import Data.Object.Base+import Data.Text.Lazy (Text)+import Data.Attempt++import Data.Time.Calendar++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as TS++#if TEST+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck (testProperty)+import Test.HUnit hiding (Test)+import Test.QuickCheck++import Control.Arrow ((***))+import Data.Convertible.Text+#endif++-- | 'Object's with keys and values of type 'Text'.+type TextObject = Object Text Text++-- | 'convertSuccess' specialized for 'TextObject's+toTextObject :: ConvertSuccess a TextObject => a -> TextObject+toTextObject = cs++-- | 'convertAttempt' specialized for 'TextObject's+fromTextObject :: ConvertAttempt TextObject a => TextObject -> Attempt a+fromTextObject = ca++$(deriveSuccessConvs ''Text ''Text+    [''Text, ''String, ''BS.ByteString, ''BL.ByteString, ''TS.Text]+    [''String, ''Day, ''Int, ''Rational, ''Bool, ''BS.ByteString,+     ''BL.ByteString, ''TS.Text, ''Text+    ])++#if TEST+testSuite :: Test+testSuite = testGroup "Data.Object.Text"+    [ testProperty "propMapKeysValuesId" propMapKeysValuesId+    , testProperty "propToFromTextObject" propToFromTextObject+    , testProperty "propStrings" propStrings+    , testCase "autoScalar" autoScalar+    , testCase "autoMapping" autoMapping+    ]++propMapKeysValuesId :: Object Int Int -> Bool+propMapKeysValuesId o = mapKeysValues id id o == o++-- FIXME consider making something automatic, though unlikely+instance ConvertAttempt TextObject (Object Int Int) where+    convertAttempt = convertObjectM+instance ConvertSuccess (Object Int Int) TextObject where+    convertSuccess = convertObject++propToFromTextObject :: Object Int Int -> Bool+propToFromTextObject o = fa (fromTextObject (toTextObject o)) == Just o++instance Arbitrary (Object Int Int) where+    coarbitrary = undefined+    arbitrary = oneof [arbS, arbL, arbM] where+        arbS = Scalar `fmap` (arbitrary :: Gen Int)+        arbL = Sequence `fmap` vector 2+        arbM = Mapping `fmap` vector 1++instance Arbitrary Char where+    coarbitrary = undefined+    arbitrary = elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']++propStrings :: String -> Bool+propStrings s = fa (sFO $ (sTO s :: TextObject)) == Just s++autoScalar :: Assertion+autoScalar = do+    let t :: Text+        t = cs "This is some text"+    Scalar t @=? toTextObject t++autoMapping :: Assertion+autoMapping = do+    let dummy = [("foo", "FOO"), ("bar", "BAR"), ("five", "5")]+        expected :: TextObject+        expected = Mapping $ map (cs *** Scalar . cs) dummy+    let test' :: (ConvertSuccess String a,+                  ConvertSuccess a Text,+                  ConvertSuccess Text a,+                  Eq a,+                  Show a,+                  ConvertSuccess a TextObject,+                  ConvertAttempt TextObject a,+                  ConvertSuccess [a] TextObject,+                  ConvertAttempt TextObject [a],+                  ConvertSuccess [(a, a)] TextObject,+                  ConvertAttempt TextObject [(a, a)],+                  ConvertSuccess [TextObject] TextObject,+                  ConvertAttempt TextObject [TextObject],+                  ConvertSuccess [(a, TextObject)] TextObject,+                  ConvertAttempt TextObject [(a, TextObject)])+             => a -> Assertion+        test' a = do+            let dummy' = map (cs *** cs) dummy `asTypeOf` [(a, a)]+                dummy'' = toTextObject dummy'+            dummy'' @?= expected+            Just dummy' @=? fa (fromTextObject expected)+            let dummyO = map (cs *** toTextObject) dummy `asTypeOf`+                            [(a, undefined :: TextObject)]+            expected @=? toTextObject dummyO+            Just dummyO @=? fa (fromTextObject expected)+    test' (undefined :: String)+    test' (undefined :: Text)+    test' (undefined :: BS.ByteString)+    test' (undefined :: BL.ByteString)+#endif

@@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2008, Michael Snoyman. All rights reserved.+Copyright 2009, Michael Snoyman. All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -2,6 +2,10 @@  > module Main where > import Distribution.Simple+> import System.Cmd (system)  > main :: IO ()-> main = defaultMain+> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' })++> runTests' :: a -> b -> c -> d -> IO ()+> runTests' _ _ _ _ = system "runhaskell Test.hs" >> return ()

@@ -1,8 +1,8 @@ name:            data-object-version:         0.0.2+version:         0.2.0 license:         BSD3 license-file:    LICENSE-author:          Michael Snoyman <michael@snoyman.com>+author:          Michael Snoyman, Nicolas Pouillard maintainer:      Michael Snoyman <michael@snoyman.com> synopsis:        Represent hierachichal structures, called objects in JSON. description:     These objects show up in different places, eg JSON, Yaml.@@ -10,16 +10,51 @@                  other libraries can share a single representation of                  these structures. category:        Data-stability:       unstable+stability:       Stable cabal-version:   >= 1.2 build-type:      Simple homepage:        http://github.com/snoyberg/data-object/tree/master +flag buildtests+  description: Build the executable to run unit tests+  default: False++flag nolib+  description: Skip building the library.+  default: False+ library+    if flag(nolib)+        Buildable: False+    else+        Buildable: True     build-depends:   base >= 4 && < 5,-                     bytestring-class,                      bytestring >= 0.9.1.4 && < 1,-                     time >= 1,-                     safe+                     text >= 0.5 && < 0.6,+                     time >= 1.1.4 && < 1.2,+                     safe-failure >= 0.4 && < 0.5,+                     old-locale >= 1 && < 1.1,+                     syb,+                     attempt >= 0.2.0 && < 0.3,+                     convertible-text >= 0.2.0 && < 0.3,+                     template-haskell     exposed-modules: Data.Object+                     Data.Object.Base+                     Data.Object.Text+                     Data.Object.Scalar+                     Data.Object.String     ghc-options:     -Wall++executable           runtests+    if flag(buildtests)+        Buildable: True+        cpp-options:     -DTEST+        build-depends:   test-framework,+                         test-framework-quickcheck,+                         test-framework-hunit,+                         HUnit,+                         QuickCheck >= 1 && < 2+    else+        Buildable: False+    ghc-options:     -Wall+    main-is:         runtests.hs

@@ -0,0 +1,12 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++import Test.Framework (defaultMain)++import qualified Data.Object.Text++main :: IO ()+main = defaultMain+    [ Data.Object.Text.testSuite+    ]