data-object 0.2.1 → 0.3.0

raw patch · 8 files changed

+206/−691 lines, 8 filesdep +failuredep −HUnitdep −QuickCheckdep −attemptsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: failure

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

API changes (from Hackage documentation)

Files

• Data/Object.hs +203/−6
• Data/Object/Base.hs +0/−375
• Data/Object/Scalar.hs +0/−64
• Data/Object/String.hs +0/−46
• Data/Object/Text.hs +0/−146
• Setup.lhs +1/−5
• data-object.cabal +2/−37
• runtests.hs +0/−12

@@ -1,10 +1,207 @@--- | Imports all instances provided in this package.+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TemplateHaskell #-}+---------------------------------------------------------+--+-- 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.+--+---------------------------------------------------------++-- | 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-    ( module Data.Object.Base+    ( -- * Object data type+      Object (..)+      -- ** Convenient type synonyms+    , StringObject+    , TextObject+      -- ** Scalar data type+    , Scalar (..)+    , ScalarObject+      -- * Basic mapping of keys and values+    , mapKeys+    , mapValues+    , mapKeysValues+    , mapKeysValuesA+    , mapKeysValuesM+      -- * Extracting underlying values+    , ObjectExtractError (..)+    , fromScalar+    , fromSequence+    , fromMapping     ) where -import Data.Object.Base+import Control.Arrow+import Control.Applicative+import Control.Monad (ap) -import Data.Object.String ()-import Data.Object.Text ()-import Data.Object.Scalar ()+import Prelude hiding (mapM, sequence)++import Data.Foldable hiding (concatMap, concat)+import Data.Traversable+import Data.Monoid++import Control.Exception (Exception)+import Data.Data (Data, Typeable)+import Control.Failure+import Data.Text (Text)+import Data.Time (UTCTime)+import Data.ByteString (ByteString)++-- | 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)++type StringObject = Object String String++-- | 'Object's with keys and values of strict 'Text'.+type TextObject = Object Text Text++data Scalar = Numeric   Rational+            | Text      Text+            | Binary    ByteString+            | Bool      Bool+            | Timestamp UTCTime+            | Null++type ScalarObject = Object String Scalar++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'++-- | 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++-- | Extract a scalar from the input, failing if the input is a sequence or+-- mapping.+fromScalar :: Failure ObjectExtractError m => Object k v -> m v+fromScalar (Scalar s) = return s+fromScalar _ = failure ExpectedScalar++-- | Extract a sequence from the input, failing if the input is a scalar or+-- mapping.+fromSequence :: Failure ObjectExtractError m+             => Object k v+             -> m [Object k v]+fromSequence (Sequence s) = return s+fromSequence _ = failure ExpectedSequence++-- | Extract a mapping from the input, failing if the input is a scalar or+-- sequence.+fromMapping :: Failure ObjectExtractError m+            => Object k v+            -> m [(k, Object k v)]+fromMapping (Mapping m) = return m+fromMapping _ = failure ExpectedMapping

@@ -1,375 +0,0 @@-{-# 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-    , lookupScalar-    , lookupSequence-    , lookupMapping-      -- * 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)--lookupScalar :: ( MonadFailure ObjectExtractError m-                , Failure (A.LookupFailure k) m-                , Eq k)-             => k-             -> [(k, Object k v)]-             -> m v-lookupScalar key = fromScalar <=< A.lookup key--lookupSequence :: ( MonadFailure ObjectExtractError m-                  , Failure (A.LookupFailure k) m-                  , Eq k)-               => k-               -> [(k, Object k v)]-               -> m [Object k v]-lookupSequence key = fromSequence <=< A.lookup key--lookupMapping :: ( MonadFailure ObjectExtractError m-                 , Failure (A.LookupFailure k) m-                 , Eq k)-              => k-              -> [(k, Object k v)]-              -> m [(k, Object k v)]-lookupMapping key = fromMapping <=< A.lookup key

@@ -1,64 +0,0 @@-{-# 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--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

@@ -1,46 +0,0 @@-{-# 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])

@@ -1,146 +0,0 @@-{-# 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

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

@@ -1,5 +1,5 @@ name:            data-object-version:         0.2.1+version:         0.3.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman, Nicolas Pouillard@@ -15,46 +15,11 @@ 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 >= 0.9.1.4 && < 1,                      text >= 0.5 && < 0.8,                      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+                     failure >= 0.1.0 && < 0.2     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

@@ -1,12 +0,0 @@-{-# 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-    ]