diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright John Ky (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,101 @@ +# hw-succinct +[![Circle CI](https://circleci.com/gh/haskell-works/hw-succinct.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-succinct) +Conduits for tokenizing streams. + +`hw-succinct` is a succinct JSON parsing library. It uses succinct data-structures to allow traversal of +large JSON strings with minimal memory overhead. + +It is currently considered experimental. + +For an example, see [`app/Main.hs`](../master/app/Main.hs) + +## Prerequisites +* Install `haskell-stack`. +* Install `hlint` (eg. `stack install hlint`) + +## Building + +Run the following in the shell: + + git clone git@github.com:haskell-works/hw-succinct.git + cd hw-succinct + stack setup + stack build + stack test + stack ghci --ghc-options -XOverloadedStrings \ + --main-is hw-succinct:exe:hw-succinct-example + +## Memory benchmark + +### Parsing large Json files in Scala with Argonaut + + S0U EU OU MU CCSU CMD + --------- --------- ----------- -------- -------- --------------------------------------------------------------- + 0.0 80,526.3 76,163.6 72,338.6 13,058.6 sbt console + 0.0 536,660.4 76,163.6 72,338.6 13,058.6 import java.io._, argonaut._, Argonaut._ + 0.0 552,389.1 76,163.6 72,338.6 13,058.6 val file = new File("/Users/jky/Downloads/78mbs.json" + 0.0 634,066.5 76,163.6 72,338.6 13,058.6 val array = new Array[Byte](file.length.asInstanceOf[Int]) + 0.0 644,552.3 76,163.6 72,338.6 13,058.6 val is = new FileInputStream("/Users/jky/Downloads/78mbs.json") + 0.0 655,038.1 76,163.6 72,338.6 13,058.6 is.read(array) + 294,976.0 160,159.7 1,100,365.0 79,310.8 13,748.1 val json = new String(array) + 285,182.9 146,392.6 1,956,264.5 82,679.8 14,099.6 val data = Parse.parse(json) + *********** + +### Parsing large Json files in Haskell with Aeson + + Mem (MB) CMD + -------- --------------------------------------------------------- + 302 import Data.Aeson + 302 import qualified Data.ByteString.Lazy as BSL + 302 json78m <- BSL.readFile "/Users/jky/Downloads/78mbs.json" + 1400 let !x = decode json78m :: Maybe Value + +### Parsing large Json files in Haskell with hw-succinct + + Mem (MB) CMD + -------- --------------------------------------------------------- + 274 import Foreign + 274 import qualified Data.Vector.Storable as DVS + 274 import qualified Data.ByteString as BS + 274 import System.IO.MMap + 274 import Data.Word + 274 (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing + 601 cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) + +## Examples + + import Foreign + import qualified Data.Vector.Storable as DVS + import qualified Data.ByteString as BS + import qualified Data.ByteString.Internal as BSI + import System.IO.MMap + import Data.Word + import System.CPUTime + (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing + cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + x <- measure $ jsonBsToInterestBs bs + let !y = runListConduit [bs] (unescape' "") + + import Foreign + import qualified Data.Vector.Storable as DVS + import qualified Data.ByteString as BS + import qualified Data.ByteString.Internal as BSI + import System.IO.MMap + import Data.Word + import System.CPUTime + (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/part40.json" ReadOnly Nothing + let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size + x <- measure $ BS.concat $ runListConduit [bs] (blankJson =$= blankedJsonToInterestBits) + x <- measure $ jsonBsToInterestBs bs + + jsonTokenAt $ J.nextSibling $ J.firstChild $ J.nextSibling $ J.firstChild $ J.firstChild cursor + +## References +* [Succinct Data Structures talk by Edward Kmett](https://www.youtube.com/watch?v=uA0Z7_4J7u8) +* [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf) +* [Conduit Overview](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/conduit-overview) + + +## Special mentions +* [Sydney Paper Club](http://www.meetup.com/Sydney-Paper-Club/) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = print "Hello world" diff --git a/hw-diagnostics.cabal b/hw-diagnostics.cabal new file mode 100644 --- /dev/null +++ b/hw-diagnostics.cabal @@ -0,0 +1,69 @@ +name: hw-diagnostics +version: 0.0.0.1 +synopsis: Conduits for tokenizing streams. +description: Please see README.md +homepage: http://github.com/haskell-works/hw-diagnostics#readme +license: BSD3 +license-file: LICENSE +author: John Ky +maintainer: newhoggy@gmail.com +copyright: 2016 John Ky +category: Data, Conduit +build-type: Simple +extra-source-files: README.md +cabal-version: >= 1.10 + +executable hw-diagnostics-example + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -msse4.2 + build-depends: base >= 4 && < 5 , + bytestring , + conduit , + criterion >= 1.1.0.0 && < 1.2 , + hw-diagnostics , + mmap , + resourcet , + vector >= 0.6 && < 0.12 + default-language: Haskell2010 + +library + hs-source-dirs: src + exposed-modules: HaskellWorks.Diagnostics + , HaskellWorks.Diagnostics.Time + build-depends: base >= 4.7 && < 5 + , array + , attoparsec >= 0.10 + , bytestring + , conduit >= 1.1 && < 1.3 + , deepseq < 1.5 + , ghc-prim + , lens + , mmap + , mono-traversable + , parsec + , QuickCheck + , random + , resourcet >= 1.1 + , safe + , text + , vector + , word8 + + default-language: Haskell2010 + ghc-options: -rtsopts -with-rtsopts=-N -Wall -msse4.2 + +test-suite hw-diagnostics-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: HaskellWorks.DiagnosticsSpec + build-depends: base + , hspec >= 1.3 + , QuickCheck + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/haskell-works/hw-diagnostics diff --git a/src/HaskellWorks/Diagnostics.hs b/src/HaskellWorks/Diagnostics.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Diagnostics.hs @@ -0,0 +1,5 @@ +module HaskellWorks.Diagnostics + ( module X + ) where + +import HaskellWorks.Diagnostics.Time as X diff --git a/src/HaskellWorks/Diagnostics/Time.hs b/src/HaskellWorks/Diagnostics/Time.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Diagnostics/Time.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE BangPatterns #-} + +module HaskellWorks.Diagnostics.Time where + +import System.CPUTime + +measure :: a -> IO a +measure a = do + start <- getCPUTime + let !b = a + end <- getCPUTime + print (end - start) + return b diff --git a/test/HaskellWorks/DiagnosticsSpec.hs b/test/HaskellWorks/DiagnosticsSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/DiagnosticsSpec.hs @@ -0,0 +1,10 @@ +module HaskellWorks.DiagnosticsSpec where + +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.DiagnosticsSpec" $ do + it "Not a test" $ + 1 `shouldBe` 1 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}