selda-json (empty) → 0.1.0.0

raw patch · 3 files changed

+89/−0 lines, 3 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, selda, text

Files

• LICENSE +21/−0
• selda-json.cabal +26/−0
• src/Database/Selda/JSON.hs +42/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017-2018 Anton Ekblad++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.

@@ -0,0 +1,26 @@+cabal-version:       >=1.10+name:                selda-json+version:             0.1.0.0+synopsis:            JSON support for the Selda database library.+-- description:+homepage:            https://selda.link+-- bug-reports:+license:             MIT+license-file:        LICENSE+author:              Anton Ekblad+maintainer:          anton@ekblad.cc+-- copyright:+category:            Database+build-type:          Simple++library+  exposed-modules:+    Database.Selda.JSON+  build-depends:+      aeson      >=1.0  && <1.5+    , base       >=4.9  && <5+    , bytestring >=0.10 && <0.11+    , selda      >=0.4  && <0.5+    , text       >=1.0  && <1.3+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,42 @@+{-# LANGUAGE GADTs, OverloadedStrings #-}+module Database.Selda.JSON (JSONBackend (..)) where+import Database.Selda (Text, Col, Inner)+import Database.Selda.Backend+import Database.Selda.Unsafe (sink, sink2)+import Data.Aeson (Value (Null), encode, decode')+import qualified Data.ByteString.Lazy as BSL (ByteString, fromStrict, toStrict)+import Data.Text.Encoding (encodeUtf8)++class JSONValue a+instance JSONValue Value+instance JSONValue a => JSONValue (Maybe a)++-- | Any backend that supports JSON lookups in queries.+class JSONBackend b where+  -- | Look up the given key in the given JSON column.+  (~>) :: JSONValue a => Col b a -> Col b Text -> Col b (Maybe Value)+  infixl 8 ~>++  -- | Convert the given JSON column to plain text.+  jsonToText :: Col b Value -> Col b Text++instance JSONBackend b => JSONBackend (Inner b) where+  (~>) = sink2 (~>)+  jsonToText = sink jsonToText++decodeError :: Show a => a -> b+decodeError x = error $ "fromSql: json column with invalid json: " ++ show x++typeError :: Show a => a -> b+typeError x = error $ "fromSql: json column with non-text value: " ++ show x++textToLazyBS :: Text -> BSL.ByteString+textToLazyBS = BSL.fromStrict . encodeUtf8++instance SqlType Value where+  mkLit = LCustom TJSON . LBlob . BSL.toStrict . encode+  sqlType _ = TJSON+  defaultValue = mkLit Null+  fromSql (SqlBlob t)   = maybe (decodeError t) id (decode' $ BSL.fromStrict t)+  fromSql (SqlString t) = maybe (decodeError t) id (decode' $ textToLazyBS t)+  fromSql x             = typeError x