persistent 1.3.0 → 1.3.0.2
raw patch · 4 files changed
+69/−5 lines, 4 filesdep +scientificdep ~aeson
Dependencies added: scientific
Dependency ranges changed: aeson
Files
- Database/Persist/Quasi.hs +14/−0
- Database/Persist/Types/Base.hs +18/−1
- persistent.cabal +3/−1
- test/main.hs +34/−3
Database/Persist/Quasi.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ViewPatterns #-} module Database.Persist.Quasi ( parse , PersistSettings (..)@@ -122,10 +123,23 @@ | isSpace (T.head t) = let (spaces, rest) = T.span isSpace t in Spaces (T.length spaces) : tokenize rest++ -- support mid-token quotes and parens+ | Just (beforeEquals, afterEquals) <- findMidToken t+ , not (T.any isSpace beforeEquals)+ , Token next : rest <- tokenize afterEquals =+ Token (T.concat [beforeEquals, "=", next]) : rest+ | otherwise = let (token, rest) = T.break isSpace t in Token token : tokenize rest where+ findMidToken t' =+ case T.break (== '=') t' of+ (x, T.drop 1 -> y)+ | "\"" `T.isPrefixOf` y || "(" `T.isPrefixOf` y -> Just (x, y)+ _ -> Nothing+ quotes t' front | T.null t' = error $ T.unpack $ T.concat $ "Unterminated quoted string starting with " : front []
Database/Persist/Types/Base.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ExistentialQuantification #-}@@ -29,6 +30,9 @@ import qualified Data.HashMap.Strict as HM import Data.Word (Word32) import Numeric (showHex, readHex)+#if MIN_VERSION_aeson(0, 7, 0)+import qualified Data.Scientific+#endif -- | A 'Checkmark' should be used as a field type whenever a -- uniqueness constraint should guarantee that a certain kind of@@ -267,7 +271,13 @@ toJSON (PersistText t) = A.String $ T.cons 's' t toJSON (PersistByteString b) = A.String $ T.cons 'b' $ TE.decodeUtf8 $ B64.encode b toJSON (PersistInt64 i) = A.Number $ fromIntegral i- toJSON (PersistDouble d) = A.Number $ AN.D d+ toJSON (PersistDouble d) = A.Number $+#if MIN_VERSION_aeson(0, 7, 0)+ Data.Scientific.fromFloatDigits+#else+ AN.D+#endif+ d toJSON (PersistRational r) = A.String $ T.pack $ 'r' : show r toJSON (PersistBool b) = A.Bool b toJSON (PersistTimeOfDay t) = A.String $ T.pack $ 't' : show t@@ -328,8 +338,15 @@ {-# INLINE i2bs #-} +#if MIN_VERSION_aeson(0, 7, 0)+ parseJSON (A.Number n) = return $+ if fromInteger (floor n) == n+ then PersistInt64 $ floor n+ else PersistDouble $ fromRational $ toRational n+#else parseJSON (A.Number (AN.I i)) = return $ PersistInt64 $ fromInteger i parseJSON (A.Number (AN.D d)) = return $ PersistDouble d+#endif parseJSON (A.Bool b) = return $ PersistBool b parseJSON A.Null = return $ PersistNull parseJSON (A.Array a) = fmap PersistList (mapM A.parseJSON $ V.toList a)
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 1.3.0+version: 1.3.0.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -43,6 +43,7 @@ , blaze-html >= 0.5 , blaze-markup >= 0.5.1 , silently+ , scientific exposed-modules: Database.Persist Database.Persist.Quasi@@ -94,6 +95,7 @@ , conduit , monad-control , blaze-html+ , scientific cpp-options: -DTEST
test/main.hs view
@@ -23,6 +23,22 @@ , Spaces 2 , Token "baz" ]+ it "handles quotes mid-token" $+ tokenize " x=\"foo bar\" \"baz\"" `shouldBe`+ [ Spaces 2+ , Token "x=foo bar"+ , Spaces 2+ , Token "baz"+ ]+ it "handles escaped quote mid-token" $+ tokenize " x=\\\"foo bar\" \"baz\"" `shouldBe`+ [ Spaces 2+ , Token "x=\\\"foo"+ , Spaces 1+ , Token "bar\""+ , Spaces 2+ , Token "baz"+ ] it "handles unnested parantheses" $ tokenize " (foo bar) (baz)" `shouldBe` [ Spaces 2@@ -30,6 +46,13 @@ , Spaces 2 , Token "baz" ]+ it "handles unnested parantheses mid-token" $+ tokenize " x=(foo bar) (baz)" `shouldBe`+ [ Spaces 2+ , Token "x=foo bar"+ , Spaces 2+ , Token "baz"+ ] it "handles nested parantheses" $ tokenize " (foo (bar)) (baz)" `shouldBe` [ Spaces 2@@ -37,12 +60,20 @@ , Spaces 2 , Token "baz" ]- it "escaping " $- tokenize " (foo \\(bar) \"baz\\\"\"" `shouldBe`+ it "escaping" $+ tokenize " (foo \\(bar) y=\"baz\\\"\"" `shouldBe` [ Spaces 2 , Token "foo (bar" , Spaces 2- , Token "baz\""+ , Token "y=baz\""+ ]+ it "mid-token quote in later token" $+ tokenize "foo bar baz=(bin\")" `shouldBe`+ [ Token "foo"+ , Spaces 1+ , Token "bar"+ , Spaces 1+ , Token "baz=bin\"" ] describe "parseFieldType" $ do it "simple types" $