json-pointer-hasql (empty) → 0.1

raw patch · 5 files changed

+225/−0 lines, 5 filesdep +aesondep +base-preludedep +eithersetup-changed

Dependencies added: aeson, base-prelude, either, hasql, json-pointer, json-pointer-hasql, rebase, text, transformers

Files

LICENSE +22/−0
Setup.hs +2/−0
json-pointer-hasql.cabal +85/−0
library/JSONPointer/Hasql/Encoders.hs +48/−0
test/Main.hs +68/−0

+ LICENSE view

@@ -0,0 +1,22 @@+Copyright (c) 2016, 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-pointer-hasql.cabal view

@@ -0,0 +1,85 @@+name:+  json-pointer-hasql+version:+  0.1+synopsis:+  JSON Pointer extensions for Hasql+description:+category:+  Hasql, JSON+homepage:+  https://github.com/sannsyn/json-pointer-hasql +bug-reports:+  https://github.com/sannsyn/json-pointer-hasql/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2016, 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-pointer-hasql.git+++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, 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:+  exposed-modules:+    JSONPointer.Hasql.Encoders+  build-depends:+    --+    hasql >= 0.19 && < 0.20,+    --+    json-pointer >= 0.1 && < 0.2,+    --+    text == 1.*,+    --+    base-prelude >= 0.1.21 && < 0.2+++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+  ghc-prof-options:+    -O2+    -threaded+    -fprof-auto+    "-with-rtsopts=-N -p -s -h -i0.1"+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    aeson,+    hasql,+    json-pointer,+    json-pointer-hasql,+    either,+    transformers,+    rebase >= 0.2.3 && < 0.3

+ library/JSONPointer/Hasql/Encoders.hs view

@@ -0,0 +1,48 @@+-- |+-- Extension to the "Hasql.Encoders" module.+-- Contains no conflicting symbols, so it can be+-- imported under the same qualified name, e.g.:+-- +-- >import qualified Hasql.Encoders as Encoders+-- >import qualified JSONPointer.Hasql.Encoders as Encoders+-- +module JSONPointer.Hasql.Encoders where++import BasePrelude+import Hasql.Encoders+import Data.Text (Text)+import JSONPointer.Model (JSONPointer)+import qualified JSONPointer.Model+++-- |+-- An encoder of JSON Pointer into the @text[]@ type of Postgres.+-- +-- Can be used to query the JSON columns,+-- as in the following example:+-- +-- >selectOfJSONByJSONPointer :: Query JSONPointer (Maybe Data.Aeson.Value)+-- >selectOfJSONByJSONPointer =+-- >  statement sql encoder decoder True+-- >  where+-- >    sql =+-- >      "select '{\"1\":[0,1,2,3]}'::jsonb #> $1"+-- >    encoder =+-- >      Encoders.value Encoders.textArrayFromJSONPointer+-- >    decoder =+-- >      Decoders.singleRow $+-- >      Decoders.nullableValue Decoders.jsonb+-- +textArrayFromJSONPointer :: Value JSONPointer+textArrayFromJSONPointer =+  array $ arrayDimension fold $ arrayValue text+  where+    fold :: (a -> Text -> a) -> a -> JSONPointer -> a+    fold step init jsonPointer =+      appEndo endo id init+      where+        endo =+          JSONPointer.Model.run jsonPointer referenceInterpreter+          where+            referenceInterpreter _ key =+              Endo $ \cont -> \a -> cont $ step a key

+ test/Main.hs view

@@ -0,0 +1,68 @@+module Main where++import Rebase.Prelude+import JSONPointer.Model (JSONPointer)+import Hasql.Query (Query)+import Hasql.Session (Session)++import qualified Hasql.Connection+import qualified Hasql.Session+import qualified Hasql.Query+import qualified Hasql.Encoders as Encoders+import qualified Hasql.Decoders as Decoders+import qualified JSONPointer.Parser+import qualified JSONPointer.Model+import qualified JSONPointer.Hasql.Encoders as Encoders+import qualified Data.Aeson+++main =+  do+    result <- query jsonPointer selectOfJSONByJSONPointerQuery+    putStrLn $ "Result is: " <> show result+    exitWith $+      if result == Just (Data.Aeson.Number 2)+        then ExitSuccess+        else ExitFailure 1+  where+    query input query =+      either (fail . show) return =<<+      runSession (Hasql.Session.query input query)+    jsonPointer =+      either (error . show) id $+      JSONPointer.Parser.run JSONPointer.Parser.jsonPointer $+      "/1/2"++runSession :: Session a -> IO (Either (Either Hasql.Connection.ConnectionError Hasql.Session.Error) a)+runSession session =+  runEitherT $ acquire >>= \connection -> use connection <* release connection+  where+    acquire =+      EitherT $ fmap (mapLeft Left) $ Hasql.Connection.acquire settings+      where+        settings =+          Hasql.Connection.settings host port user password database+          where+            host = "localhost"+            port = 5432+            user = "postgres"+            password = ""+            database = "postgres"+    use connection =+      EitherT $+      fmap (mapLeft Right) $+      Hasql.Session.run session connection+    release connection =+      lift $ Hasql.Connection.release connection++selectOfJSONByJSONPointerQuery :: Query JSONPointer (Maybe Data.Aeson.Value)+selectOfJSONByJSONPointerQuery =+  Hasql.Query.statement sql encoder decoder True+  where+    sql =+      "select '{\"1\":[0,1,2,3]}'::jsonb #> $1"+    encoder =+      Encoders.value Encoders.textArrayFromJSONPointer+    decoder =+      Decoders.singleRow $+      Decoders.nullableValue Decoders.jsonb