diff --git a/bench/bench.hs b/bench/bench.hs new file mode 100644 --- /dev/null +++ b/bench/bench.hs @@ -0,0 +1,32 @@ +module Main (main) where + +import Control.Lens ((&), (.~)) +import Criterion.Main +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as LBS +import HaskellWorks.Data.Dsv.Lazy.Cursor (DsvCursor, makeCursor) + +import Data.Sv +import qualified Data.Sv.Decode as D + +opts :: ParseOptions +opts = defaultParseOptions & headedness .~ Unheaded + +pd :: Decode' BS8.ByteString a -> DsvCursor -> DecodeValidation BS8.ByteString [a] +pd dec = parseDecodeFromDsvCursor dec opts + +main :: IO () +main = + defaultMain + [ bench "double" $ nf (pd D.double) doublesC + , bench "rational" $ nf (pd (D.rational :: Decode' BS.ByteString Double)) doublesC + ] + +doubles :: LBS.ByteString +doubles = + LBS.fromStrict . BS.intercalate (BS8.singleton '\n') $ + fmap (BS8.pack . show) [0 :: Double, 1, 1.1102230246251565e-16, 7.845860130857695, 5000000000] + +doublesC :: DsvCursor +doublesC = makeCursor 10 doubles diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Revision history for sv +## 1.2 -- 2018-09-26 + +* Update to sv-core 0.3 + ## 1.1.1 -- 2018-08-10 * Depend on sv-core 0.2.1 to get column-name-based encoding diff --git a/sv.cabal b/sv.cabal --- a/sv.cabal +++ b/sv.cabal @@ -1,5 +1,5 @@ name: sv -version: 1.1.1 +version: 1.2 license: BSD3 license-file: LICENCE author: George Wilson @@ -98,7 +98,7 @@ , contravariant >= 1.2 && < 1.6 , hw-dsv >= 0.2.1 && < 0.3 , semigroupoids >= 5 && <6 - , sv-core >= 0.2.1 && < 0.3 + , sv-core >= 0.3 && < 0.4 , transformers >= 0.2 && < 0.6 , utf8-string >= 1 && < 1.1 , validation >= 1 && < 1.1 @@ -143,3 +143,27 @@ -Wall hs-source-dirs: test + +benchmark criterion + type: + exitcode-stdio-1.0 + main-is: + bench.hs + default-language: + Haskell2010 + build-depends: + attoparsec >= 0.12.1.4 && < 0.14 + , base >=4.8 && <5 + , bytestring >= 0.9.1.10 && < 0.11 + , criterion >= 1.3 && < 1.6 + , deepseq >= 1.1 && < 1.5 + , hw-dsv >= 0.2.1 && < 0.3 + , lens >= 4 && < 5 + , sv + , text >= 1.0 && < 1.3 + , vector >= 0.10 && < 0.13 + + ghc-options: + -Wall -O2 + hs-source-dirs: + bench diff --git a/test/Data/Sv/DecodeTest.hs b/test/Data/Sv/DecodeTest.hs --- a/test/Data/Sv/DecodeTest.hs +++ b/test/Data/Sv/DecodeTest.hs @@ -108,7 +108,7 @@ data Semi = Semi Text Int Double Text deriving (Eq, Show) semiD :: D.Decode' ByteString Semi -semiD = Semi <$> D.utf8 <*> (parseDecoder `o` D.contents) <*> D.double <*> D.utf8 +semiD = Semi <$> D.utf8 <*> (parseDecoder `o` D.contents) <*> D.rational <*> D.utf8 semigroupoidTest :: TestTree semigroupoidTest = testGroup "Semigroupoid Decode" @@ -120,7 +120,7 @@ Failure (DecodeErrors (pure (BadDecode "no"))) , testCase "Does the right thing in the case of right failure" $ parseDecode semiD opts semiTestString3 @?= - Failure (DecodeErrors (pure (BadDecode "Couldn't parse \"false\" as a double"))) + Failure (DecodeErrors (pure (BadDecode "Couldn't decode \"false\": input does not start with a digit"))) ] -- This CSV has enough columns to make an Item, it has more columns than a @@ -143,34 +143,34 @@ inOrder :: NameDecode' ByteString Item inOrder = Item <$> D.column "id" D.int <*> D.column "name" D.utf8 - <*> D.column "cost" D.double <*> D.column "units" D.int + <*> D.column "cost" D.rational <*> D.column "units" D.int outOrder :: NameDecode' ByteString Item outOrder = (\n u c i -> Item i n c u) <$> D.column "name" D.utf8 - <*> D.column "units" D.int <*> D.column "cost" D.double + <*> D.column "units" D.int <*> D.column "cost" D.rational <*> D.column "id" D.int inOrderSemi :: NameDecode' ByteString SemiItem inOrderSemi = - SemiItem <$> D.column "name" D.utf8 <*> D.column "cost" D.double + SemiItem <$> D.column "name" D.utf8 <*> D.column "cost" D.rational outOrderSemi :: NameDecode' ByteString SemiItem2 outOrderSemi = - SemiItem2 <$> D.column "units" D.int <*> D.column "cost" D.double + SemiItem2 <$> D.column "units" D.int <*> D.column "cost" D.rational super :: NameDecode' ByteString SuperItem super = SuperItem <$> D.column "id" D.int <*> D.column "name" D.utf8 <*> D.column "manufacturer" D.utf8 - <*> D.column "cost" D.double <*> D.column "units" D.int + <*> D.column "cost" D.rational <*> D.column "units" D.int super2 :: NameDecode' ByteString SuperItem2 super2 = SuperItem2 <$> D.column "id" D.int <*> D.column "name" D.utf8 <*> D.column "manufacturer" D.utf8 - <*> D.column "cost" D.double <*> D.column "units" D.int - <*> D.column "profit" D.double + <*> D.column "cost" D.rational <*> D.column "units" D.int + <*> D.column "profit" D.rational namedTest :: TestTree namedTest = testGroup "Named decodes" diff --git a/test/Data/Sv/RoundTripsDecodeEncode.hs b/test/Data/Sv/RoundTripsDecodeEncode.hs --- a/test/Data/Sv/RoundTripsDecodeEncode.hs +++ b/test/Data/Sv/RoundTripsDecodeEncode.hs @@ -8,6 +8,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.UTF8 as UTF8 import Data.Semigroup ((<>)) +import Data.String (IsString) import Test.Tasty (TestName, TestTree, testGroup) import Test.Tasty.HUnit ((@?=), testCase) @@ -25,6 +26,7 @@ , integer , float , double + , rational , string , byteString , lazyByteString @@ -100,15 +102,24 @@ , ("1000000", 1000000) ] -float :: TestTree -float = roundTripCodecIso "float" D.float E.float +floatingTests :: (IsString s, Fractional a) => [(s,a)] +floatingTests = [ ("5.0", 5) , ("10.5", 10.5) , ("12345.678", 12345.678) ] +float :: TestTree +float = roundTripCodecIso "float" D.float E.float + floatingTests + double :: TestTree -double = roundTripCodecIso "double" D.double E.double [("5.0", 5)] +double = roundTripCodecIso "double" D.double E.double + floatingTests + +rational :: TestTree +rational = roundTripCodecIso "rational" D.rational E.double + (("7.845860130857695", 7.845860130857695) : floatingTests) text :: TestTree text = roundTripCodecIso "text" D.utf8 E.text [(utf8lb "hello", "hello"), (utf8lb "💩💩💩💩", "💩💩💩💩")]