hedn 0.1.6.0 → 0.1.7.0

raw patch · 8 files changed

+669/−283 lines, 8 filesdep +QuickCheckdep +hspecdep +old-localedep ~HUnitdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, hspec, old-locale, template-haskell, time

Dependency ranges changed: HUnit, base, bytestring, containers, deepseq

API changes (from Hackage documentation)

Files

• hedn.cabal +31/−13
• src/Data/EDN/Parser.hs +30/−13
• src/Data/EDN/Types.hs +19/−0
• src/Data/EDN/Types/Class.hs +214/−22
• tests/Data/EDN/Test/QuickCheck.hs +74/−0
• tests/Data/EDN/Test/QuickCheck/TH.hs +61/−0
• tests/Data/EDN/Test/Unit.hs +233/−0
• tests/Main.hs +7/−235

@@ -1,8 +1,5 @@--- Initial hedn.cabal generated by cabal init.  For further documentation, --- see http://haskell.org/cabal/users-guide/- name:                hedn-version:             0.1.6.0+version:             0.1.7.0 synopsis:            EDN parsing and encoding homepage:            https://bitbucket.org/dpwiz/hedn license:             BSD3@@ -20,29 +17,50 @@  extra-source-files:   tests/Main.hs+  tests/Data/EDN/Test/*.hs+  tests/Data/EDN/Test/QuickCheck/TH.hs  flag developer   description: operate in developer mode   default: False  library-  exposed-modules:     Data.EDN, Data.EDN.Types, Data.EDN.Parser, Data.EDN.Encode, Data.EDN.Types.Class-  other-modules:       Data.Parser-  hs-source-dirs:      src/-  build-depends:       base ==4.*, attoparsec, text, bytestring, containers, vector, stringsearch, mtl, deepseq+  exposed-modules:+      Data.EDN,+      Data.EDN.Types,+      Data.EDN.Types.Class,+      Data.EDN.Parser,+      Data.EDN.Encode -  if flag(developer)-    ghc-options: -Werror-    ghc-prof-options: -auto-all+  other-modules:+      Data.Parser -  ghc-options: -O2 -Wall -fno-warn-unused-do-bind+  hs-source-dirs: src/+  build-depends:+      base ==4.*,+      attoparsec,+      text,+      bytestring >=0.10,+      containers,+      vector,+      stringsearch,+      mtl,+      deepseq,+      old-locale,+      time +--  if flag(developer)+--    ghc-options: -Werror -fhpc+--    ghc-prof-options: -auto-all +  ghc-options: -O2 -Wall -fno-warn-unused-do-bind+ Test-Suite tests   type:              exitcode-stdio-1.0   main-is:           Main.hs   hs-source-dirs:    tests/-  build-depends:     base, hedn, HUnit, bytestring, text, containers, vector+  build-depends:     base, hedn, bytestring, text, containers, vector, template-haskell, time,+                     QuickCheck >= 2.5.1, hspec == 1.5.*, HUnit >= 1.2.5   ghc-options:       -Wall  source-repository head

@@ -10,20 +10,22 @@     parseValue, parseTagged ) where -import Prelude hiding (String, takeWhile)-import Data.Attoparsec.Char8 as A-import qualified Data.Attoparsec.Lazy as AL-import Data.Attoparsec.Combinator()-import Control.Applicative (pure, (<|>), (*>))-import qualified Data.ByteString.Char8 as BS+import           Control.Applicative        (pure, (*>), (<|>))+import           Data.Attoparsec.Char8      as A+import           Data.Attoparsec.Combinator ()+import qualified Data.Attoparsec.Lazy       as AL+import qualified Data.ByteString.Char8      as BS import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import Data.ByteString.Search (replace)+import           Data.ByteString.Search     (replace)+import qualified Data.Text                  as T+import qualified Data.Text.Encoding         as TE+import qualified Data.Text.Lazy             as TL+import qualified Data.Text.Lazy.Encoding    as TLE+import           Prelude                    hiding (String, takeWhile) -import Data.EDN.Types (Value(..), Tagged(..), TaggedValue, makeVec, makeMap, makeSet)+import           Data.EDN.Types             (Tagged (..), TaggedValue,+                                             Value (..), makeMap, makeSet,+                                             makeVec)  isSpaceOrComma :: Char -> Bool isSpaceOrComma ' ' = True@@ -64,7 +66,14 @@     char '"'      if '\\' `BS.elem` x-        then return $! String . TE.decodeUtf8 . rep "\\\"" "\"". rep "\\\\" "\\" . rep "\\n" "\n" . rep "\\r" "\r" . rep "\\t" "\t" $ x+        then return $! String+                     . TE.decodeUtf8+                     . rep "\\\"" "\""+                     . rep "\\\\" "\\"+                     . rep "\\n" "\n"+                     . rep "\\r" "\r"+                     . rep "\\t" "\t"+                     $ x         else return $! String . TE.decodeUtf8 $ x      where rep f t s = BS.concat . BSL.toChunks $! replace (BS.pack f) (BS.pack t) s@@ -119,7 +128,9 @@ parseList = do     skipSoC     char '('+    A.skipSpace     vs <- parseTagged `sepBy` spaceOrComma+    A.skipSpace     char ')'     return $! List vs @@ -127,7 +138,9 @@ parseVector = do     skipSoC     char '['+    A.skipSpace     vs <- parseTagged `sepBy` spaceOrComma+    A.skipSpace     char ']'     return $! makeVec vs @@ -135,7 +148,9 @@ parseMap = do     skipSoC     char '{'+    A.skipSpace     pairs <- parseAssoc `sepBy` spaceOrComma+    A.skipSpace     char '}'     return $! makeMap pairs     where@@ -149,7 +164,9 @@     skipSoC     char '#'     char '{'+    A.skipSpace     vs <- parseTagged `sepBy` spaceOrComma+    A.skipSpace     char '}'     return $! makeSet vs 

@@ -25,6 +25,7 @@ ) where  import Data.String (IsString(..))+import Control.DeepSeq (NFData(..)) import Data.Text (Text) import qualified Data.Text as T import Data.ByteString.Char8 (ByteString)@@ -42,6 +43,10 @@     fmap f (NoTag v) = NoTag (f v)     fmap f (Tagged v ns t) = Tagged (f v) ns t +instance NFData a => NFData (Tagged a) where+    rnf (NoTag v) = rnf v+    rnf (Tagged v ns t) = rnf v `seq` rnf ns `seq` rnf t+ type TaggedValue = Tagged Value  type EDNList = [TaggedValue] -- ^ An EDN list (head:tail container).@@ -74,6 +79,20 @@ instance IsString (Tagged Value) where   fromString = string . T.pack   {-# INLINE fromString #-}++instance NFData Value where+  rnf (Map m) = rnf m+  rnf (Set s) = rnf s+  rnf (Vec v) = V.foldl' (\x y -> rnf y `seq` x) () v+  rnf (List l) = rnf l+  rnf (Floating f) = rnf f+  rnf (Integer i) = rnf i+  rnf (Symbol ns s) = rnf ns `seq` rnf s+  rnf (Keyword kw) = rnf kw+  rnf (String t) = rnf t+  rnf (Character c) = rnf c+  rnf (Boolean b) = rnf b+  rnf Nil = ()  -- | Basic EDN nil. nil :: TaggedValue

@@ -1,5 +1,6 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, IncoherentInstances #-}-+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE OverloadedStrings   #-} module Data.EDN.Types.Class (     -- * Type conversion     ToEDN(..), FromEDN(..), fromEDN, fromEDNv,@@ -11,23 +12,27 @@     (.=), (.:), (.:?), (.!=), typeMismatch ) where -import Control.Applicative (pure, (<$>))-import Control.Monad (liftM, liftM2)-import Data.Maybe (fromMaybe)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy.Encoding as TLE-import qualified Data.ByteString.Char8 as BS+import           Control.Applicative        (pure, (<$>), (<*>))+import           Control.Monad              (liftM, liftM2)+import qualified Data.ByteString.Char8      as BS import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.Vector as V-import qualified Data.Set as S-import qualified Data.Map as M+import qualified Data.Map                   as M+import           Data.Maybe                 (fromMaybe)+import           Data.Monoid                (First (..), mconcat)+import qualified Data.Set                   as S+import qualified Data.Text                  as T+import qualified Data.Text.Encoding         as TE+import qualified Data.Text.Lazy             as TL+import qualified Data.Text.Lazy.Encoding    as TLE+import           Data.Time.Clock            (UTCTime)+import           Data.Time.Format           (formatTime, parseTime)+import qualified Data.Vector                as V -import Data.Parser (Parser, Result)-import qualified Data.Parser as DP-import qualified Data.EDN.Parser as P-import qualified Data.EDN.Types as E+import qualified Data.EDN.Parser            as P+import qualified Data.EDN.Types             as E+import           Data.Parser                (Parser, Result)+import qualified Data.Parser                as DP+import           System.Locale              (defaultTimeLocale)  -- | A type that can be converted to JSON. class ToEDN a where@@ -59,8 +64,8 @@     {-# INLINE toEDN #-}  instance (FromEDN a) => (FromEDN (Maybe a)) where-    parseEDNv E.Nil = pure Nothing-    parseEDNv a = Just <$> parseEDNv a+    parseEDN (E.NoTag E.Nil) = pure Nothing+    parseEDN a = Just <$> parseEDN a     {-# INLINE parseEDNv #-}  instance (ToEDN a, ToEDN b) => ToEDN (Either a b) where@@ -178,6 +183,46 @@     parseEDNv v = typeMismatch "Integer" v     {-# INLINE parseEDNv #-} +instance ToEDN Int where+    toEDNv = E.Integer . fromIntegral+    {-# INLINE toEDNv #-}++instance FromEDN Int where+    parseEDNv (E.Integer i) = return (fromIntegral i)+    parseEDNv v = typeMismatch "Int" v+++showRFC3339 :: UTCTime -> String+showRFC3339 time =+    concat [fm "%FT%T." time+           ,  take 3 $ fm "%-q" time+           ,  "+00:00"]+  where+    fm s = formatTime defaultTimeLocale s++instance ToEDN UTCTime where+    toEDN time = E.Tagged (E.String . T.pack $ showRFC3339 time)+                          ""+                          "inst"+    {-# INLINE toEDN #-}++instance FromEDN UTCTime where+    parseEDN val@(E.Tagged (E.String ts) "" "inst") = do+        let result = getFirst . mconcat $ map (First . parseTime') validRFC3339+        case result of+          Just time -> return time+          Nothing -> typeMismatch "UTCTime" $ E.stripTag val+      where+        tsStr = T.unpack ts+        parseTime' fmt = parseTime defaultTimeLocale fmt tsStr+        validRFC3339 = [ "%FT%T%Q%z"+                       , "%FT%T%QZ"+                       , "%FT%T%z"+                       , "%FT%TZ" ]+    parseEDN v = typeMismatch "UTCTime" $ E.stripTag v+    {-# INLINE parseEDN #-}++ instance ToEDN a => ToEDN [a] where     toEDNv = E.List . map toEDN     {-# INLINE toEDNv #-}@@ -214,6 +259,146 @@     parseEDNv v = typeMismatch "Map" v     {-# INLINE parseEDNv #-} +instance (ToEDN a, ToEDN b) => ToEDN (a, b) where+    toEDNv (a, b) = E.Vec $! V.fromList [toEDN a, toEDN b]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b) => FromEDN (a, b) where+    parseEDNv v@(E.Vec vec)+      | (V.length vec == 2) = (,) <$> (parseEDN (vec V.! 0))+                                  <*> (parseEDN (vec V.! 1))+      | otherwise = typeMismatch "(a, b)" v+    parseEDNv v = typeMismatch "(a, b)" v+    {-# INLINE parseEDNv #-}++instance (ToEDN a, ToEDN b, ToEDN c) => ToEDN (a, b, c) where+    toEDNv (a, b, c) = E.Vec $! V.fromList [toEDN a, toEDN b, toEDN c]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b, FromEDN c) => FromEDN (a, b, c) where+    parseEDNv v@(E.Vec vec)+      | V.length vec == 3 = (,,) <$> (parseEDN (vec V.! 0))+                                 <*> (parseEDN (vec V.! 1))+                                 <*> (parseEDN (vec V.! 2))+      | otherwise = typeMismatch "(a, b, c)" v+    parseEDNv v = typeMismatch "(a, b, c)" v+    {-# INLINE parseEDNv #-}++instance (ToEDN a, ToEDN b, ToEDN c, ToEDN d) => ToEDN (a, b, c, d) where+    toEDNv (a, b, c, d) = E.Vec $! V.fromList [toEDN a, toEDN b, toEDN c, toEDN d]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d) => FromEDN (a, b, c, d) where+    parseEDNv v@(E.Vec vec)+      | V.length vec == 4 = (,,,) <$> (parseEDN (vec V.! 0))+                                  <*> (parseEDN (vec V.! 1))+                                  <*> (parseEDN (vec V.! 2))+                                  <*> (parseEDN (vec V.! 3))+      | otherwise = typeMismatch "(a, b, c, d)" v+    parseEDNv v = typeMismatch "(a, b, c, d)" v+    {-# INLINE parseEDNv #-}++instance (ToEDN a, ToEDN b, ToEDN c, ToEDN d, ToEDN e) => ToEDN (a, b, c, d, e) where+    toEDNv (a, b, c, d, e) = E.Vec $! V.fromList [+                               toEDN a+                             , toEDN b+                             , toEDN c+                             , toEDN d+                             , toEDN e ]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d, FromEDN e)+    => FromEDN (a, b, c, d, e) where+    parseEDNv v@(E.Vec vec)+      | V.length vec == 5 = (,,,,) <$> (parseEDN (vec V.! 0))+                                   <*> (parseEDN (vec V.! 1))+                                   <*> (parseEDN (vec V.! 2))+                                   <*> (parseEDN (vec V.! 3))+                                   <*> (parseEDN (vec V.! 4))+      | otherwise = typeMismatch "(a, b, c, d, e)" v+    parseEDNv v = typeMismatch "(a, b, c, d, e)" v+    {-# INLINE parseEDNv #-}++instance (ToEDN a, ToEDN b, ToEDN c, ToEDN d, ToEDN e, ToEDN f)+    => ToEDN (a, b, c, d, e, f) where+    toEDNv (a, b, c, d, e, f) = E.Vec $! V.fromList [+                               toEDN a+                             , toEDN b+                             , toEDN c+                             , toEDN d+                             , toEDN e+                             , toEDN f]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d, FromEDN e, FromEDN f)+    => FromEDN (a, b, c, d, e, f) where+    parseEDNv v@(E.Vec vec)+      | V.length vec == 6 = (,,,,,) <$> (parseEDN (vec V.! 0))+                                    <*> (parseEDN (vec V.! 1))+                                    <*> (parseEDN (vec V.! 2))+                                    <*> (parseEDN (vec V.! 3))+                                    <*> (parseEDN (vec V.! 4))+                                    <*> (parseEDN (vec V.! 5))+      | otherwise = typeMismatch "(a, b, c, d, e, f)" v+    parseEDNv v = typeMismatch "(a, b, c, d, e, f)" v+    {-# INLINE parseEDNv #-}++instance (ToEDN a, ToEDN b, ToEDN c, ToEDN d, ToEDN e, ToEDN f, ToEDN g)+    => ToEDN (a, b, c, d, e, f, g) where+    toEDNv (a, b, c, d, e, f, g) = E.Vec $! V.fromList [+                               toEDN a+                             , toEDN b+                             , toEDN c+                             , toEDN d+                             , toEDN e+                             , toEDN f+                             , toEDN g]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d, FromEDN e, FromEDN f, FromEDN g)+    => FromEDN (a, b, c, d, e, f, g) where+    parseEDNv v@(E.Vec vec)+      | V.length vec == 7 = (,,,,,,) <$> (parseEDN (vec V.! 0))+                                     <*> (parseEDN (vec V.! 1))+                                     <*> (parseEDN (vec V.! 2))+                                     <*> (parseEDN (vec V.! 3))+                                     <*> (parseEDN (vec V.! 4))+                                     <*> (parseEDN (vec V.! 5))+                                     <*> (parseEDN (vec V.! 6))+      | otherwise = typeMismatch "(a, b, c, d, e, f, g)" v+    parseEDNv v = typeMismatch "(a, b, c, d, e, f, g)" v+    {-# INLINE parseEDNv #-}++instance (ToEDN a, ToEDN b, ToEDN c, ToEDN d, ToEDN e, ToEDN f, ToEDN g, ToEDN h)+    => ToEDN (a, b, c, d, e, f, g, h) where+    toEDNv (a, b, c, d, e, f, g, h) = E.Vec $! V.fromList [+                               toEDN a+                             , toEDN b+                             , toEDN c+                             , toEDN d+                             , toEDN e+                             , toEDN f+                             , toEDN g+                             , toEDN h]+    {-# INLINE toEDNv #-}++instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d,+          FromEDN e, FromEDN f, FromEDN g, FromEDN h)+    => FromEDN (a, b, c, d, e, f, g, h) where+    parseEDNv v@(E.Vec vec)+      | V.length vec == 8 = (,,,,,,,) <$> (parseEDN (vec V.! 0))+                                      <*> (parseEDN (vec V.! 1))+                                      <*> (parseEDN (vec V.! 2))+                                      <*> (parseEDN (vec V.! 3))+                                      <*> (parseEDN (vec V.! 4))+                                      <*> (parseEDN (vec V.! 5))+                                      <*> (parseEDN (vec V.! 6))+                                      <*> (parseEDN (vec V.! 7))+      | otherwise = typeMismatch "(a, b, c, d, e, f, g, h)" v+    parseEDNv v = typeMismatch "(a, b, c, d, e, f, g, h)" v+    {-# INLINE parseEDNv #-}++ instance ToEDN E.Value where     toEDNv = id @@ -281,7 +466,7 @@ -- from an object without affecting its validity and we know a default -- value to assign in that case.  If the key and value are mandatory, -- use '(.:)' instead.--- +-- -- Example usage: -- -- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"@@ -314,10 +499,17 @@         E.Map _ -> "Map"         E.Set _ -> "Set" -mapMset :: (Monad m, Ord b) => (a -> m b) -> S.Set a -> m (S.Set b)+mapMset :: (Monad m, Ord b)+        => (a -> m b)+        -> S.Set a+        -> m (S.Set b) mapMset f s = mapM f (S.toList s) >>= return . S.fromList {-# INLINE mapMset #-} -mapMmap :: (Ord a2, Monad m) => (a1 -> m a2) -> (b1 -> m b2) -> M.Map a1 b1 -> m (M.Map a2 b2)+mapMmap :: (Ord a2, Monad m)+        => (a1 -> m a2)+        -> (b1 -> m b2)+        -> M.Map a1 b1+        -> m (M.Map a2 b2) mapMmap kf vf = liftM M.fromList . mapM (\(k, v) -> liftM2 (,) (kf k) (vf v)) . M.assocs {-# INLINE mapMmap #-}

@@ -0,0 +1,74 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.EDN.Test.QuickCheck where++import           Data.EDN.Test.QuickCheck.TH+import           Data.Time                   (UTCTime)++import qualified Data.Time.Calendar          as Calendar+import           Data.Time.Clock             (UTCTime (..), UniversalTime (..),+                                              secondsToDiffTime)+import           Data.Time.LocalTime         (localTimeToUT1, localTimeToUTC,+                                              ut1ToLocalTime, utc,+                                              utcToLocalTime)++import qualified Test.QuickCheck             as QC++-- * UTCTime Arbitrary instance ------------------------------------------------++fromGregorian :: Integer -> Int -> Int -> Int -> Int -> Int -> UTCTime+fromGregorian year month day hours minutes seconds =+    UTCTime day' (secondsToDiffTime . fromIntegral $ seconds')+  where+    day'     = Calendar.fromGregorian year month day+    seconds' = 3600 * hours + 60 * minutes + seconds++fromUniversalTime :: UniversalTime -> UTCTime+fromUniversalTime = localTimeToUTC utc . ut1ToLocalTime 0++toUniversalTime :: UTCTime -> UniversalTime+toUniversalTime = localTimeToUT1 0 . utcToLocalTime utc++fromGregorian' :: Integer -> Int -> Int -> UTCTime+fromGregorian' y m d = fromGregorian y m d 0 0 0++startOfTime :: UTCTime+startOfTime = fromGregorian' 1970 1 1++fromMJD :: Rational -> UTCTime+fromMJD = fromUniversalTime . ModJulianDate++fromMJD' :: Float -> UTCTime+fromMJD' = fromMJD . realToFrac++startOfTimeMJD :: Rational+startOfTimeMJD = toMJD startOfTime++toMJD :: UTCTime -> Rational+toMJD = getModJulianDate . toUniversalTime++instance QC.Arbitrary UTCTime where+    -- coarbitrary = undefined+    arbitrary = do+      offset <- QC.choose (0, 20000) :: QC.Gen Float+      return . fromMJD' $ offset + fromRational startOfTimeMJD++--------------------------------------------------------------------------------++type MUTCTime = Maybe UTCTime+type Tuple  = (Int, Int)+type Triple = (Int, String, UTCTime)+type Tuple4 = (Int, String, [Maybe UTCTime], [Maybe Bool])+type Tuple5 = (Int, [String], [Maybe UTCTime], [Maybe Bool], (Bool, Bool))++$(mkSerializeSpecs [+                   -- ''Char    -- encode/decode are not isomorphic with Char+                   --  ''Double -- encode/decode are not isomorphic with Double+                   -- ''String+                     ''UTCTime+                   , ''MUTCTime+                   -- , ''Tuple+                   -- , ''Triple+                   -- , ''Tuple4+                   -- , ''Tuple5+                   ])

@@ -0,0 +1,61 @@+{-# LANGUAGE TemplateHaskell #-}+module Data.EDN.Test.QuickCheck.TH where++import           Control.Applicative   ((<$>), (<*>))+import           Language.Haskell.TH+import           Test.Hspec            (Spec, describe)+import           Test.Hspec.QuickCheck (prop)++++import qualified Data.EDN              as E+import qualified Test.QuickCheck       as QC++--------------------------------------------------------------------------------++serializeProperty :: (QC.Arbitrary a, Eq a, E.ToEDN a, E.FromEDN a) => a -> Bool+serializeProperty object = do+  case decoded of+    Just result -> result == object+    Nothing -> False+  where+      encoded = E.encode object+      decoded = E.decode encoded++getTestPropertyName :: Name -> Name+getTestPropertyName qualTypeName =+    mkName $ "test" ++ (nameBase qualTypeName) ++ "Serialization"++mkEDNSerializeSpecGroup :: [Name] -> Q [Dec]+mkEDNSerializeSpecGroup names = do+    let fnName = mkName "ednSerializationProperties"+    specType <- [t| Spec |]+    describeFn <- [| describe |]+    return $ [ SigD fnName specType+             , ValD (VarP fnName)+                    (NormalB (AppE (AppE describeFn+                                        (LitE (StringL "EDN.Serialization")))+                                   (DoE (map (NoBindS . VarE . getTestPropertyName)+                                             names)))) []]++mkSerializeSpec :: Name -> Q [Dec]+mkSerializeSpec qualTypeName = do+    let typeName = nameBase qualTypeName+        fnName = getTestPropertyName qualTypeName+    propFn <- [| prop |]+    serializePropertyFn <- [| serializeProperty |]+    boolType <- [t| Bool |]+    specType <- [t| Spec |]+    return [ SigD fnName specType+           , ValD (VarP fnName)+                    (NormalB (AppE+                      (AppE propFn+                        (LitE (StringL $ typeName ++ " serialization/deserialization")))+                      (SigE serializePropertyFn+                        (AppT (AppT ArrowT (ConT qualTypeName))+                              boolType)))) []]++mkSerializeSpecs :: [Name] -> Q [Dec]+mkSerializeSpecs types =+    (++) <$> (concat `fmap` mapM mkSerializeSpec types)+         <*> (mkEDNSerializeSpecGroup types)

@@ -0,0 +1,233 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}+module Data.EDN.Test.Unit (tests) where++import Test.HUnit++import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text.Lazy as TL+import qualified Data.Text as T++import qualified Data.Vector as V+import qualified Data.Set as S+import qualified Data.Map as M++import Data.EDN (encode, decode, ToEDN, toEDN, FromEDN, fromEDN)+import Data.EDN.Types as E+import Data.EDN.Types.Class (Result(..), (.=))+import Data.EDN.Parser (parseMaybe)++tests :: Test+tests = TestList [ TestLabel "BSL -> TV parser" $ TestList $ map makeParserCase parserCases+                 , TestLabel "TV -> BSL encoder" $ TestList $ map makeEncodeCase encodeCases+                 , TestLabel "ToEDN conversion" $ TestList $ map makeToEDNcase toEDNcases+                 , TestLabel "FromEDN converter/decoder" $ TestList $ map makeFromEDNcase fromEDNcases+                 , TestLabel "decoder fail" (TestCase (assertEqual "bad unicode" Nothing (parseMaybe "№")))+                 , TestLabel "'Tagged a' conversion" $ TestList taggedConversion+                 ]++makeParserCase :: (BSL.ByteString, E.TaggedValue) -> Test+makeParserCase (i, o) = TestCase (assertEqual (BSL.unpack i) (Just o) (parseMaybe i))++makeEncodeCase :: (E.TaggedValue, BSL.ByteString) -> Test+makeEncodeCase (i, o) = TestCase (assertEqual (BSL.unpack o) o (encode i))++parserCases :: [(BSL.ByteString, E.TaggedValue)]+parserCases = [ ("nil", E.nil)++              , ("true", E.true)+              , ("false", E.false)++              , ("\"a nice string\"", "a nice string")+              , ("\"split\\second \\t\\rai\\n\"", "split\\second \t\rai\n")+              , ("\"test \\\"sausage\\\" shmest\"", "test \"sausage\" shmest")+              , ("\"\"", "")++              , ("\\c", E.char 'c')+              , ("\\\\", E.char '\\')+              , ("\\newline", E.char '\n')+              , ("\\space", E.char ' ')+              , ("\\tab", E.char '\t')++              , ("justasymbol", E.symbol "justasymbol")+              , ("with#stuff:inside", E.symbol "with#stuff:inside")+              , ("my-namespace/foo", E.symbolNS "my-namespace" "foo")+              , ("/", E.symbol "/")++              , (":fred", E.keyword "fred")+              , (":my/fred", E.keyword "my/fred")++              , ("42", E.integer 42)+              , ("-1", E.integer (-1))++              , ("100.50", E.floating 100.5)+              , ("-3.14", E.floating (-3.14))+               -- ...and many other strange stuff...++              , ("(a b 42)", sampleList)+              , ("()", E.notag $ E.makeList [])++              , ("[a b 42]", sampleVec)+              , ("[]", E.notag $ E.makeVec [])++              , ("{:a 1, \"foo\" :bar, [1 2 3] four}", sampleMap)+              , ("{}", E.notag $ E.makeMap [])++              , ("#{a b [1 2 3]}", sampleSet)+              , ("#{}", E.notag $ E.makeSet [])++              , ("[a b #_foo 42]", sampleDiscard)+              , ("(1 2 ;more to go!\n 3 4)", sampleComment)++              , ("#myapp/Person {:first \"Fred\" :last \"Mertz\"}", E.tag "myapp" "Person" sampleTaggedMap)+              , ("{:first \"Fred\" :last \"Mertz\"}", E.notag sampleTaggedMap)+              ]++encodeCases :: [(E.TaggedValue, BSL.ByteString)]+encodeCases = [ (E.nil, "nil")++              , (E.true, "true")+              , (E.false, "false")++              , (E.string "a nice string", "\"a nice string\"")+              , ("overloaded", "\"overloaded\"")+              , ("escape \rou\te \\ \"\north\"", "\"escape \\rou\\te \\\\ \\\"\\north\\\"\"")++              , (E.char 'c', "\\c")+              , (E.char '\\', "\\\\")+              , (E.char '\n', "\\newline")+              , (E.char '\r', "\\return")+              , (E.char '\t', "\\tab")+              , (E.char ' ', "\\space")++              , (E.symbol "justasymbol", "justasymbol")+              , (E.symbol "with#stuff:inside", "with#stuff:inside")+              , (E.symbolNS "whatever" "whenever", "whatever/whenever")+              , (E.symbol "/", "/")++              , (E.keyword "fred", ":fred")+              , (E.keyword "my/fred", ":my/fred")+              , (E.notag ":overloaded", ":overloaded") -- IsString kw transform only for untagged values++              , (E.integer 42, "42")+              , (E.integer (-1), "-1")++              , (E.floating 100.50, "100.5")+              , (E.floating (-3.14), "-3.14")++              , (sampleList, "(a b 42)")+              , (E.notag $ E.makeList [], "()")++              , (sampleVec, "[a b 42]")+              , (E.notag $ E.makeVec [], "[]")++              , (sampleMap, "{\"foo\" :bar :a 1 [1 2 3] four}") -- Order not guaranteed+              , (E.notag $ E.makeMap [], "{}")++              , (E.tag "myapp" "Person" sampleTaggedMap, "#myapp/Person {:first \"Fred\" :last \"Mertz\"}")+              ]++sampleList :: E.TaggedValue+sampleList = E.notag $ E.makeList [E.symbol "a", E.symbol "b", E.integer 42]++sampleVec :: E.TaggedValue+sampleVec = E.notag $ E.makeVec [E.symbol "a", E.symbol "b", E.integer 42]++sampleMap :: E.TaggedValue+sampleMap = E.notag $ E.makeMap [ (":a",                                              E.integer 1)+                                , ("foo",                                             E.keyword "bar")+                                , (E.makeVec [E.integer 1, E.integer 2, E.integer 3], E.symbol "four")+                                ]++sampleSet :: E.TaggedValue+sampleSet = E.notag $ E.makeSet [ E.symbol "a"+                                , E.symbol "b"+                                , E.notag $ E.makeVec [E.integer 1, E.integer 2, E.integer 3]+                                ]++sampleDiscard :: E.TaggedValue+sampleDiscard = E.notag $ E.makeVec [E.symbol "a", E.symbol "b", E.integer 42]++sampleComment :: E.TaggedValue+sampleComment = E.notag $ E.makeList [E.integer 1, E.integer 2, E.integer 3, E.integer 4]++sampleTaggedMap :: E.Value+sampleTaggedMap = E.makeMap [ "first" .= E.string "Fred", "last" .= E.string "Mertz" ]++data ToEDNCase = forall a. ToEDN a => ToEDNCase !a !E.TaggedValue++makeToEDNcase :: ToEDNCase -> Test+makeToEDNcase (ToEDNCase i o) = TestCase (assertEqual (show o) o (toEDN i))++toEDNcases :: [ToEDNCase]+toEDNcases = [ ToEDNCase (Nothing :: Maybe Bool) E.nil++             , ToEDNCase (Left "hi" :: Either String ()) $ E.tag "either" "left" "hi"+             , ToEDNCase (Right "z" :: Either () String) $ E.tag "either" "right" "z"+             , ToEDNCase (Just '!') (E.char '!')++             , ToEDNCase True E.true+             , ToEDNCase False E.false++             , ToEDNCase ("test" :: String) (E.string "test")+             , ToEDNCase ("test" :: BSL.ByteString) "test"+             , ToEDNCase ("test" :: BS.ByteString) "test"+             , ToEDNCase ("test" :: TL.Text) "test"+             , ToEDNCase ("test" :: T.Text) "test"++             , ToEDNCase 'c' $ E.char 'c'+             , ToEDNCase '\n' $ E.char '\n'+             , ToEDNCase '\\' $ E.char '\\'++             , ToEDNCase (3.14 :: Double) $ E.floating 3.14+             , ToEDNCase (42 :: Integer) $ E.integer 42++             , ToEDNCase () (E.notag $ E.makeList [])+             , ToEDNCase ([] :: [()]) (E.notag $ E.makeList [])+             , ToEDNCase (["yo", "wassup"] :: [String]) (E.notag $ E.makeList ["yo", "wassup"])+             , ToEDNCase [E.string "i", "am", E.symbolNS "boxed" "container"] (E.notag $ E.makeList [E.string "i", "am", E.symbolNS "boxed" "container"])++             , ToEDNCase (V.fromList ['o', 'm', 'g']) (E.notag $ E.makeVec [E.char 'o', E.char 'm', E.char 'g'])++             , ToEDNCase (S.fromList ['o', 'm', 'g']) (E.notag $ E.makeSet [E.char 'o', E.char 'm', E.char 'g'])++             , ToEDNCase (M.fromList [("test", "shmest"), ("foo", "bar")] :: M.Map String String) (E.notag $ E.makeMap [("test", "shmest"), ("foo", "bar")])+             , ToEDNCase (M.fromList [(":test", "shmest"), (":foo", "bar")] :: EDNMap) (E.notag $ E.makeMap ["test" .= E.string "shmest", "foo" .= E.string "bar"])+             ]++data FromEDNCase = forall a. (FromEDN a, Show a, Eq a) => FromEDNCase !BSL.ByteString !a++makeFromEDNcase :: FromEDNCase -> Test+makeFromEDNcase (FromEDNCase i o) = TestCase $ assertEqual (BSL.unpack i) (Just o) (decode i)++fromEDNcases :: [FromEDNCase]+fromEDNcases = [ FromEDNCase "nil" (Nothing :: Maybe Bool)++               , FromEDNCase "false" False+               , FromEDNCase "true" True++               , FromEDNCase "#either/left hi" (Left "hi" :: Either String ())+               , FromEDNCase "#either/right z" (Right "z" :: Either () String)+               , FromEDNCase "\"ok fine\"" (Just "ok fine" :: Maybe T.Text)+               , FromEDNCase "nil" (Nothing :: Maybe BSL.ByteString)++               , FromEDNCase "\\newline" '\n'+               , FromEDNCase "\\z" 'z'++               , FromEDNCase "42" (42 :: Integer)+               , FromEDNCase "-3.14" (-3.14 :: Double)++               , FromEDNCase "(hello world)" (["hello", "world"] :: [String])+               , FromEDNCase "[3 2 1 \"Kaboom!\"]" $ E.makeVec [E.integer 3, E.integer 2, E.integer 1, "Kaboom!"]+               , FromEDNCase "#{a/bag :of \"bugs\"}" $ E.makeSet [E.symbolNS "a" "bag", E.keyword "of", E.string "bugs"]+               , FromEDNCase "{json: \"like\", but/not: \"really\"}" $ (M.fromList [("json:", "like"), ("but/not:", "really")] :: M.Map String String)+               , FromEDNCase "{ json: \"like\", but/not: \"really\" }" $ (M.fromList [("json:", "like"), ("but/not:", "really")] :: M.Map String String)+               ]++taggedConversion :: [Test]+taggedConversion = [ TestCase (assertEqual "toEDN tagged" (E.tag "wo" "ot" (E.Boolean False)) (toEDN $ E.tag "wo" "ot" False))+                   , TestCase (assertEqual "toEDN notag" E.false (toEDN $ E.notag False))+                   , TestCase (assertEqual "fromEDN tagged" (Success $ E.tag "wo" "ot" False) (fromEDN $ E.tag "wo" "ot" (E.Boolean False)))+                   , TestCase (assertEqual "fromEDN notag" (Success $ E.notag False) (fromEDN $ E.false))+                   ]

@@ -1,239 +1,11 @@-{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}- module Main where--import Test.HUnit-import Control.Monad (when)-import System.Exit (exitFailure)--import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.ByteString.Char8 as BS-import qualified Data.Text.Lazy as TL-import qualified Data.Text as T--import qualified Data.Vector as V-import qualified Data.Set as S-import qualified Data.Map as M+import           Test.Hspec.HUnit         (fromHUnitTest)+import           Test.Hspec.Runner        (hspec) -import Data.EDN (encode, decode, ToEDN, toEDN, FromEDN, fromEDN)-import Data.EDN.Types as E-import Data.EDN.Types.Class (Result(..), (.=))-import Data.EDN.Parser (parseMaybe)+import           Data.EDN.Test.QuickCheck (ednSerializationProperties)+import           Data.EDN.Test.Unit       (tests)  main :: IO ()-main = do-    (Counts _ _ e f) <- runTestTT tests-    when (e > 0 || f > 0) $ exitFailure--tests :: Test-tests = TestList [ TestLabel "BSL -> TV parser" $ TestList $ map makeParserCase parserCases-                 , TestLabel "TV -> BSL encoder" $ TestList $ map makeEncodeCase encodeCases-                 , TestLabel "ToEDN conversion" $ TestList $ map makeToEDNcase toEDNcases-                 , TestLabel "FromEDN converter/decoder" $ TestList $ map makeFromEDNcase fromEDNcases-                 , TestLabel "decoder fail" (TestCase (assertEqual "bad unicode" Nothing (parseMaybe "№")))-                 , TestLabel "'Tagged a' conversion" $ TestList taggedConversion-                 ]--makeParserCase :: (BSL.ByteString, E.TaggedValue) -> Test-makeParserCase (i, o) = TestCase (assertEqual (BSL.unpack i) (Just o) (parseMaybe i))--makeEncodeCase :: (E.TaggedValue, BSL.ByteString) -> Test-makeEncodeCase (i, o) = TestCase (assertEqual (BSL.unpack o) o (encode i))--parserCases :: [(BSL.ByteString, E.TaggedValue)]-parserCases = [ ("nil", E.nil)--              , ("true", E.true)-              , ("false", E.false)--              , ("\"a nice string\"", "a nice string")-              , ("\"split\\second \\t\\rai\\n\"", "split\\second \t\rai\n")-              , ("\"test \\\"sausage\\\" shmest\"", "test \"sausage\" shmest")-              , ("\"\"", "")--              , ("\\c", E.char 'c')-              , ("\\\\", E.char '\\')-              , ("\\newline", E.char '\n')-              , ("\\space", E.char ' ')-              , ("\\tab", E.char '\t')--              , ("justasymbol", E.symbol "justasymbol")-              , ("with#stuff:inside", E.symbol "with#stuff:inside")-              , ("my-namespace/foo", E.symbolNS "my-namespace" "foo")-              , ("/", E.symbol "/")--              , (":fred", E.keyword "fred")-              , (":my/fred", E.keyword "my/fred")--              , ("42", E.integer 42)-              , ("-1", E.integer (-1))--              , ("100.50", E.floating 100.5)-              , ("-3.14", E.floating (-3.14))-               -- ...and many other strange stuff...--              , ("(a b 42)", sampleList)-              , ("()", E.notag $ E.makeList [])--              , ("[a b 42]", sampleVec)-              , ("[]", E.notag $ E.makeVec [])--              , ("{:a 1, \"foo\" :bar, [1 2 3] four}", sampleMap)-              , ("{}", E.notag $ E.makeMap [])--              , ("#{a b [1 2 3]}", sampleSet)-              , ("#{}", E.notag $ E.makeSet [])--              , ("[a b #_foo 42]", sampleDiscard)-              , ("(1 2 ;more to go!\n 3 4)", sampleComment)--              , ("#myapp/Person {:first \"Fred\" :last \"Mertz\"}", E.tag "myapp" "Person" sampleTaggedMap)-              , ("{:first \"Fred\" :last \"Mertz\"}", E.notag sampleTaggedMap)-              ]--encodeCases :: [(E.TaggedValue, BSL.ByteString)]-encodeCases = [ (E.nil, "nil")--              , (E.true, "true")-              , (E.false, "false")--              , (E.string "a nice string", "\"a nice string\"")-              , ("overloaded", "\"overloaded\"")-              , ("escape \rou\te \\ \"\north\"", "\"escape \\rou\\te \\\\ \\\"\\north\\\"\"")--              , (E.char 'c', "\\c")-              , (E.char '\\', "\\\\")-              , (E.char '\n', "\\newline")-              , (E.char '\r', "\\return")-              , (E.char '\t', "\\tab")-              , (E.char ' ', "\\space")--              , (E.symbol "justasymbol", "justasymbol")-              , (E.symbol "with#stuff:inside", "with#stuff:inside")-              , (E.symbolNS "whatever" "whenever", "whatever/whenever")-              , (E.symbol "/", "/")--              , (E.keyword "fred", ":fred")-              , (E.keyword "my/fred", ":my/fred")-              , (E.notag ":overloaded", ":overloaded") -- IsString kw transform only for untagged values--              , (E.integer 42, "42")-              , (E.integer (-1), "-1")--              , (E.floating 100.50, "100.5")-              , (E.floating (-3.14), "-3.14")--              , (sampleList, "(a b 42)")-              , (E.notag $ E.makeList [], "()")--              , (sampleVec, "[a b 42]")-              , (E.notag $ E.makeVec [], "[]")--              , (sampleMap, "{\"foo\" :bar :a 1 [1 2 3] four}") -- Order not guaranteed-              , (E.notag $ E.makeMap [], "{}")--              , (E.tag "myapp" "Person" sampleTaggedMap, "#myapp/Person {:first \"Fred\" :last \"Mertz\"}")-              ]--sampleList :: E.TaggedValue-sampleList = E.notag $ E.makeList [E.symbol "a", E.symbol "b", E.integer 42]--sampleVec :: E.TaggedValue-sampleVec = E.notag $ E.makeVec [E.symbol "a", E.symbol "b", E.integer 42]--sampleMap :: E.TaggedValue-sampleMap = E.notag $ E.makeMap [ (":a",                                              E.integer 1)-                                , ("foo",                                             E.keyword "bar")-                                , (E.makeVec [E.integer 1, E.integer 2, E.integer 3], E.symbol "four")-                                ]--sampleSet :: E.TaggedValue-sampleSet = E.notag $ E.makeSet [ E.symbol "a"-                                , E.symbol "b"-                                , E.notag $ E.makeVec [E.integer 1, E.integer 2, E.integer 3]-                                ]--sampleDiscard :: E.TaggedValue-sampleDiscard = E.notag $ E.makeVec [E.symbol "a", E.symbol "b", E.integer 42]--sampleComment :: E.TaggedValue-sampleComment = E.notag $ E.makeList [E.integer 1, E.integer 2, E.integer 3, E.integer 4]--sampleTaggedMap :: E.Value-sampleTaggedMap = E.makeMap [ "first" .= E.string "Fred", "last" .= E.string "Mertz" ]--data ToEDNCase = forall a. ToEDN a => ToEDNCase !a !E.TaggedValue--makeToEDNcase :: ToEDNCase -> Test-makeToEDNcase (ToEDNCase i o) = TestCase (assertEqual (show o) o (toEDN i))--toEDNcases :: [ToEDNCase]-toEDNcases = [ ToEDNCase (Nothing :: Maybe Bool) E.nil--             , ToEDNCase (Left "hi" :: Either String ()) $ E.tag "either" "left" "hi"-             , ToEDNCase (Right "z" :: Either () String) $ E.tag "either" "right" "z"-             , ToEDNCase (Just '!') (E.char '!')--             , ToEDNCase True E.true-             , ToEDNCase False E.false--             , ToEDNCase ("test" :: String) (E.string "test")-             , ToEDNCase ("test" :: BSL.ByteString) "test"-             , ToEDNCase ("test" :: BS.ByteString) "test"-             , ToEDNCase ("test" :: TL.Text) "test"-             , ToEDNCase ("test" :: T.Text) "test"--             , ToEDNCase 'c' $ E.char 'c'-             , ToEDNCase '\n' $ E.char '\n'-             , ToEDNCase '\\' $ E.char '\\'--             , ToEDNCase (3.14 :: Double) $ E.floating 3.14-             , ToEDNCase (42 :: Integer) $ E.integer 42--             , ToEDNCase () (E.notag $ E.makeList [])-             , ToEDNCase ([] :: [()]) (E.notag $ E.makeList [])-             , ToEDNCase (["yo", "wassup"] :: [String]) (E.notag $ E.makeList ["yo", "wassup"])-             , ToEDNCase [E.string "i", "am", E.symbolNS "boxed" "container"] (E.notag $ E.makeList [E.string "i", "am", E.symbolNS "boxed" "container"])--             , ToEDNCase (V.fromList ['o', 'm', 'g']) (E.notag $ E.makeVec [E.char 'o', E.char 'm', E.char 'g'])--             , ToEDNCase (S.fromList ['o', 'm', 'g']) (E.notag $ E.makeSet [E.char 'o', E.char 'm', E.char 'g'])--             , ToEDNCase (M.fromList [("test", "shmest"), ("foo", "bar")] :: M.Map String String) (E.notag $ E.makeMap [("test", "shmest"), ("foo", "bar")])-             , ToEDNCase (M.fromList [(":test", "shmest"), (":foo", "bar")] :: EDNMap) (E.notag $ E.makeMap ["test" .= E.string "shmest", "foo" .= E.string "bar"])-             ]--data FromEDNCase = forall a. (FromEDN a, Show a, Eq a) => FromEDNCase !BSL.ByteString !a--makeFromEDNcase :: FromEDNCase -> Test-makeFromEDNcase (FromEDNCase i o) = TestCase $ assertEqual (BSL.unpack i) (Just o) (decode i)--fromEDNcases :: [FromEDNCase]-fromEDNcases = [ FromEDNCase "nil" (Nothing :: Maybe Bool)--               , FromEDNCase "false" False-               , FromEDNCase "true" True--               , FromEDNCase "#either/left hi" (Left "hi" :: Either String ())-               , FromEDNCase "#either/right z" (Right "z" :: Either () String)-               , FromEDNCase "\"ok fine\"" (Just "ok fine" :: Maybe T.Text)-               , FromEDNCase "nil" (Nothing :: Maybe BSL.ByteString)--               , FromEDNCase "\\newline" '\n'-               , FromEDNCase "\\z" 'z'--               , FromEDNCase "42" (42 :: Integer)-               , FromEDNCase "-3.14" (-3.14 :: Double)--               , FromEDNCase "(hello world)" (["hello", "world"] :: [String])-               , FromEDNCase "[3 2 1 \"Kaboom!\"]" $ E.makeVec [E.integer 3, E.integer 2, E.integer 1, "Kaboom!"]-               , FromEDNCase "#{a/bag :of \"bugs\"}" $ E.makeSet [E.symbolNS "a" "bag", E.keyword "of", E.string "bugs"]-               , FromEDNCase "{json: \"like\", but/not: \"really\"}" $ (M.fromList [("json:", "like"), ("but/not:", "really")] :: M.Map String String)-               ]--taggedConversion :: [Test]-taggedConversion = [ TestCase (assertEqual "toEDN tagged" (E.tag "wo" "ot" (E.Boolean False)) (toEDN $ E.tag "wo" "ot" False))-                   , TestCase (assertEqual "toEDN notag" E.false (toEDN $ E.notag False))-                   , TestCase (assertEqual "fromEDN tagged" (Success $ E.tag "wo" "ot" False) (fromEDN $ E.tag "wo" "ot" (E.Boolean False)))-                   , TestCase (assertEqual "fromEDN notag" (Success $ E.notag False) (fromEDN $ E.false))-                   ]+main = hspec $ do+  fromHUnitTest tests+  ednSerializationProperties