packages feed

json-encoder (empty) → 0.1.3.1

raw patch · 7 files changed

+420/−0 lines, 7 filesdep +basedep +base-preludedep +bytestringsetup-changed

Dependencies added: base, base-prelude, bytestring, bytestring-tree-builder, contravariant, contravariant-extras, scientific, text

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Sannsyn AS++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ json-encoder.cabal view
@@ -0,0 +1,61 @@+name:+  json-encoder+version:+  0.1.3.1+synopsis:+  A very fast single-pass JSON encoder with a declarative DSL+description:+category:+  JSON, Codec+homepage:+  https://github.com/sannsyn/json-encoder +bug-reports:+  https://github.com/sannsyn/json-encoder/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2015, Sannsyn AS+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/sannsyn/json-encoder.git+++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+    JSONEncoder.Prelude+    JSONEncoder.Builders+    JSONEncoder.ByteStrings+  exposed-modules:+    JSONEncoder+  build-depends:+    --+    text == 1.*,+    bytestring >= 0.10 && < 0.11,+    bytestring-tree-builder >= 0.2.2.1 && < 0.3,+    scientific >= 0.3 && < 0.4,+    --+    contravariant-extras == 0.3.*,+    contravariant >= 1.3 && < 2,+    -- +    base-prelude >= 0.1.19 && < 0.2,+    base >= 4.6 && < 5
+ library/JSONEncoder.hs view
@@ -0,0 +1,183 @@+module JSONEncoder+(+  run,+  -- * Value+  Value,+  null,+  boolean,+  number_integral,+  number_scientific,+  string,+  object,+  array,+  nullable,+  -- * Object+  Object,+  field,+  -- * Array+  Array,+  homo,+  hetero,+  -- * Hetero+  Hetero,+  element,+)+where++import JSONEncoder.Prelude hiding (length, null)+import ByteString.TreeBuilder+import qualified JSONEncoder.Builders as Builders+import qualified Data.Scientific+++run :: Value a -> a -> Builder+run (Value (Op producer)) input =+  producer input+++-- * Value+-------------------------++newtype Value a =+  Value (Op Builder a)+  deriving (Contravariant, Divisible, Decidable)++null :: Value ()+null =+  Value $ Op $+  const "null"++boolean :: Value Bool+boolean =+  Value $ Op $+  \case+    True -> "true"+    False -> "false"++number_integral :: Integral a => Value a+number_integral =+  Value $ Op $+  fromString . show . toInteger++number_scientific :: Value Data.Scientific.Scientific+number_scientific =+  Value $ Op $+  fromString . show++string :: Value Text+string =+  Value $ Op $+  Builders.stringLiteral++object :: Object a -> Value a+object (Object (Op sectionsProducer)) =+  Value $ Op $+    sectionsProducer >>>+    mappend (Builders.asciiChar '{') >>>+    flip mappend (Builders.asciiChar '}')++array :: Array a -> Value a+array (Array (Op sectionsProducer)) =+  Value $ Op $+    sectionsProducer >>>+    mappend (Builders.asciiChar '[') >>>+    flip mappend (Builders.asciiChar ']')++nullable :: Value a -> Value (Maybe a)+nullable =+  choose (maybe (Left ()) Right) null+++-- * Object+-------------------------++newtype Object a =+  Object (Op Builder a)+  deriving (Contravariant)++instance Divisible Object where+  conquer =+    mempty+  divide divisor (Object (Op producer1)) (Object (Op producer2)) =+    Object $ Op $ +      divisor >>> \(input1, input2) ->+      Builders.appendWithIncut (Builders.asciiChar ',') (producer1 input1) (producer2 input2)++instance Decidable Object where+  lose f =+    Object (lose f)+  choose f (Object op1) (Object op2) =+    Object (choose f op1 op2)++instance Monoid (Object a) where+  mempty =+    Object (Op (const mempty))+  mappend (Object (Op producer1)) (Object (Op producer2)) =+    Object (Op (Builders.appendWithIncut (Builders.asciiChar ',') <$> producer1 <*> producer2))++field :: Text -> Value a -> Object a+field name (Value (Op producer)) =+  Object $ Op $ +    producer >>>+    mappend (Builders.asciiChar ':') >>>+    mappend (Builders.stringLiteral name)+++-- * Array+-------------------------++newtype Array a =+  Array (Op Builder a)+  deriving (Contravariant)++-- |+-- A homogenous array.+homo :: (forall a. (a -> b -> a) -> a -> c -> a) -> Value b -> Array c+homo foldl (Value (Op producer)) =+  Array (Op arrayProducer)+  where+    arrayProducer =+      foldl step mempty+      where+        step acc =+          Builders.appendWithIncut (Builders.asciiChar ',') acc .+          producer++-- |+-- A heterogenous array encoder.+hetero :: Hetero a -> Array a+hetero (Hetero op) =+  Array op+++-- * Hetero+-------------------------++newtype Hetero a =+  Hetero (Op Builder a)+  deriving (Contravariant)++instance Divisible Hetero where+  conquer =+    mempty+  divide divisor (Hetero (Op producer1)) (Hetero (Op producer2)) =+    Hetero $ Op $ +      divisor >>> \(input1, input2) ->+      Builders.appendWithIncut (Builders.asciiChar ',') (producer1 input1) (producer2 input2)++instance Decidable Hetero where+  lose f =+    Hetero (lose f)+  choose f (Hetero op1) (Hetero op2) =+    Hetero (choose f op1 op2)++instance Monoid (Hetero a) where+  mempty =+    Hetero (Op (const mempty))+  mappend (Hetero (Op producer1)) (Hetero (Op producer2)) =+    Hetero (Op (Builders.appendWithIncut (Builders.asciiChar ',') <$> producer1 <*> producer2))++element :: Value a -> Hetero a+element (Value op) =+  Hetero op+
+ library/JSONEncoder/Builders.hs view
@@ -0,0 +1,62 @@+module JSONEncoder.Builders where++import JSONEncoder.Prelude hiding (length)+import ByteString.TreeBuilder+import qualified JSONEncoder.ByteStrings as ByteStrings+import qualified Data.Text+++{-# INLINABLE intercalate #-}+intercalate :: Foldable f => Builder -> f Builder -> Builder+intercalate incut =+  foldl' (appendWithIncut incut) mempty++{-# INLINABLE appendWithIncut #-}+appendWithIncut :: Builder -> Builder -> Builder -> Builder+appendWithIncut incut a b =+  if length a == 0+    then b+    else if length b == 0+      then a+      else a <> incut <> b++{-# INLINE asciiChar #-}+asciiChar :: Char -> Builder+asciiChar =+  byte . fromIntegral . ord++{-# INLINE utf8Char #-}+utf8Char :: Char -> Builder+utf8Char =+  byteString . ByteStrings.utf8Char++{-# INLINABLE stringEncodedChar #-}+stringEncodedChar :: Char -> Builder+stringEncodedChar =+  \case+    '\"' -> "\\\""+    '\\' -> "\\\\"+    '\n' -> "\\n"+    '\r' -> "\\r"+    '\t' -> "\\t"+    char -> encodedChar char++{-# INLINABLE encodedChar #-}+encodedChar :: Char -> Builder+encodedChar char =+  if char < '\x20'+    then +      let+        hex =+          fromString (showHex (fromEnum char) "")+        in "\\u" <> mconcat (replicate (4 - length hex) (asciiChar '0')) <> hex+    else+      utf8Char char++{-# INLINABLE stringLiteral #-}+stringLiteral :: Text -> Builder+stringLiteral string =+  asciiChar '"' <> encoded string <> asciiChar '"'+  where+    encoded =+      Data.Text.foldl' (\builder -> mappend builder . stringEncodedChar) mempty
+ library/JSONEncoder/ByteStrings.hs view
@@ -0,0 +1,60 @@+module JSONEncoder.ByteStrings where++import JSONEncoder.Prelude+import Foreign+import qualified Data.ByteString.Internal as C+++{-# INLINE utf8Char #-}+utf8Char :: Char -> ByteString+utf8Char =+  utf8Ord . ord++{-# INLINE utf8Ord #-}+utf8Ord :: Int -> ByteString+utf8Ord x =+  if+    | x <= 0x7F ->+      bytes1 (fromIntegral x)+    | x <= 0x07FF ->+      bytes2 (fromIntegral ((x `shiftR` 6) + 0xC0))+             (fromIntegral ((x .&. 0x3F) + 0x80))+    | x <= 0xFFFF ->+      bytes3 (fromIntegral (x `shiftR` 12) + 0xE0)+             (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80)+             (fromIntegral (x .&. 0x3F) + 0x80)+    | otherwise ->+      bytes4 (fromIntegral (x `shiftR` 18) + 0xF0)+             (fromIntegral ((x `shiftR` 12) .&. 0x3F) + 0x80)+             (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80)+             (fromIntegral (x .&. 0x3F) + 0x80)++{-# INLINE bytes1 #-}+bytes1 :: Word8 -> ByteString+bytes1 byte1 =+  C.unsafeCreate 1 $ \ptr -> do+    pokeByteOff ptr 0 byte1++{-# INLINE bytes2 #-}+bytes2 :: Word8 -> Word8 -> ByteString+bytes2 byte1 byte2 =+  C.unsafeCreate 2 $ \ptr -> do+    pokeByteOff ptr 0 byte1+    pokeByteOff ptr 1 byte2++{-# INLINE bytes3 #-}+bytes3 :: Word8 -> Word8 -> Word8 -> ByteString+bytes3 byte1 byte2 byte3 =+  C.unsafeCreate 3 $ \ptr -> do+    pokeByteOff ptr 0 byte1+    pokeByteOff ptr 1 byte2+    pokeByteOff ptr 2 byte3++{-# INLINE bytes4 #-}+bytes4 :: Word8 -> Word8 -> Word8 -> Word8 -> ByteString+bytes4 byte1 byte2 byte3 byte4 =+  C.unsafeCreate 4 $ \ptr -> do+    pokeByteOff ptr 0 byte1+    pokeByteOff ptr 1 byte2+    pokeByteOff ptr 2 byte3+    pokeByteOff ptr 3 byte4
+ library/JSONEncoder/Prelude.hs view
@@ -0,0 +1,30 @@+module JSONEncoder.Prelude+( +  module Exports,+)+where++-- base+-------------------------+import Numeric as Exports++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (fail, Alt)++-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports++-- contravariant-extras+-------------------------+import Contravariant.Extras as Exports++-- text+-------------------------+import Data.Text as Exports (Text)++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)