hasql-simple (empty) → 0.1.0.0
raw patch · 5 files changed
+263/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, contravariant, hasql, text, time, unordered-containers, vector
Files
- LICENSE +30/−0
- README.md +33/−0
- Setup.hs +2/−0
- hasql-simple.cabal +33/−0
- src/Hasql/Simple.hs +165/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexander Thiemann (c) 2017++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 Alexander Thiemann 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.
+ README.md view
@@ -0,0 +1,33 @@+# hasql-simple++[](https://circleci.com/gh/agrafix/hasql-simple)++A somewhat opinionated "simpler" API to hasql. This allows to write code like:++```haskell+import Hasql.Query+import Hasql.Simple+import qualified Hasql.Decoders as D++data NewUser+ = NewUser+ { nu_username :: !T.Text+ , nu_email :: !T.Text+ , nu_password :: !(Password 'PtHash)+ } deriving (Show)++createUserQ :: Query NewUser UserId+createUserQ =+ statement sql encoder decoder True+ where+ sql =+ "INSERT INTO login (username, email, password) VALUES ($1, $2, $3) RETURNING id;"+ encoder =+ req nu_username+ <> req nu_email+ <> req nu_password+ decoder =+ D.singleRow dbDecVal+```++The `-simple` in the name is due to this type class approach beeing similar to the one found in `postgresql-simple`. All contributions (e.g. more instances and/or helper functions) are welcome, please send a PR.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hasql-simple.cabal view
@@ -0,0 +1,33 @@+name: hasql-simple+version: 0.1.0.0+synopsis: A somewhat opinionated "simpler" API to hasql+description: A somewhat opinionated "simpler" API to hasql+homepage: https://github.com/agrafix/hasql-simple#readme+license: BSD3+license-file: LICENSE+author: Alexander Thiemann+maintainer: mail@athiemann.net+copyright: 2017 Alexander Thiemann <mail@athiemann.net>+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Hasql.Simple+ build-depends: base >= 4.7 && < 5+ , hasql+ , aeson >= 1.1+ , text >= 1.2+ , vector >= 0.12+ , unordered-containers >= 0.2+ , contravariant >= 1.4+ , time >= 1.6+ , bytestring >= 0.10+ default-language: Haskell2010+++source-repository head+ type: git+ location: https://github.com/agrafix/hasql-simple
+ src/Hasql/Simple.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+module Hasql.Simple where++import Data.Aeson+import Data.Aeson.Types+import Data.Bifunctor+import Data.Functor.Contravariant+import Data.Int+import Data.Time+import qualified Data.ByteString as BS+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Hasql.Decoders as D+import qualified Hasql.Encoders as E++req :: DbEncode v => (a -> v) -> E.Params a+req get = get ->. dbEnc++opt :: DbEncode v => (a -> Maybe v) -> E.Params a+opt get = get ->? dbEnc++(->.) :: (a -> v) -> E.Value v -> E.Params a+get ->. ser =+ contramap get (E.value ser)++(->?) :: (a -> Maybe v) -> E.Value v -> E.Params a+get ->? ser =+ contramap get (E.nullableValue ser)++class RowUnpacker r where+ unpackRows :: forall e. D.Row e -> D.Result (r e)++instance RowUnpacker V.Vector where+ unpackRows = D.rowsVector++instance RowUnpacker Maybe where+ unpackRows = D.maybeRow++type family DbRepr t++class DbEncode t where+ packVal :: t -> DbRepr t+ dbEnc :: E.Value t++ default packVal :: t ~ DbRepr t => t -> DbRepr t+ packVal = id++ default dbEnc :: DbEncode (DbRepr t) => E.Value t+ dbEnc = contramap packVal dbEnc++-- | Short for @D.value dbDec@+dbDecVal :: DbDecode t => D.Row t+dbDecVal = D.value dbDec++-- | Short for @D.nullableValue dbDec@+dbDecOptVal :: DbDecode t => D.Row (Maybe t)+dbDecOptVal = D.nullableValue dbDec+++class DbDecode t where+ unpackVal :: DbRepr t -> t+ dbDec :: D.Value t++ default unpackVal :: t ~ DbRepr t => DbRepr t -> t+ unpackVal = id++ default dbDec :: DbDecode (DbRepr t) => D.Value t+ dbDec = unpackVal <$> dbDec++type instance DbRepr Bool = Bool+instance DbEncode Bool where+ dbEnc = E.bool++instance DbDecode Bool where+ dbDec = D.bool++type instance DbRepr T.Text = T.Text+instance DbEncode T.Text where+ dbEnc = E.text++instance DbDecode T.Text where+ dbDec = D.text++type instance DbRepr Int64 = Int64+instance DbEncode Int64 where+ dbEnc = E.int8++instance DbDecode Int64 where+ dbDec = D.int8++type instance DbRepr Double = Double+instance DbEncode Double where+ dbEnc = E.float8++instance DbDecode Double where+ dbDec = D.float8++type instance DbRepr BS.ByteString = BS.ByteString+instance DbEncode BS.ByteString where+ dbEnc = E.bytea++instance DbDecode BS.ByteString where+ dbDec = D.bytea++type instance DbRepr UTCTime = UTCTime+instance DbEncode UTCTime where+ dbEnc = E.timestamptz++instance DbDecode UTCTime where+ dbDec = D.timestamptz++type instance DbRepr Day = Day+instance DbEncode Day where+ dbEnc = E.date++instance DbDecode Day where+ dbDec = D.date++type instance DbRepr (V.Vector a) = V.Vector a -- this is a bit cheated here ...+instance DbEncode a => DbEncode (V.Vector a) where+ dbEnc = E.array (E.arrayDimension V.foldl' (E.arrayValue dbEnc))++instance DbDecode a => DbDecode (V.Vector a) where+ dbDec = D.array (D.arrayDimension V.replicateM (D.arrayValue dbDec))++type instance DbRepr (HM.HashMap T.Text a) = HM.HashMap T.Text a -- this is a bit cheated here ...+instance ToJSON a => DbEncode (HM.HashMap T.Text a) where+ dbEnc = jsonbE++instance FromJSON a => DbDecode (HM.HashMap T.Text a) where+ dbDec = jsonbD++jsonbE :: ToJSON a => E.Value a+jsonbE = contramap toJSON E.jsonb++jsonbD :: FromJSON a => D.Value a+jsonbD = D.jsonbBytes (first T.pack . eitherDecodeStrict')++jsonbD' :: (Value -> Parser a) -> D.Value a+jsonbD' parser =+ D.jsonbBytes $ \raw ->+ do v <-+ first (\pError -> T.pack (pError ++ ": Value was: " ++ show raw)) $+ eitherDecodeStrict' raw+ first (\pError -> T.pack (pError ++ ": Value was: " ++ show v)) $ parseEither parser v++jsonVec :: (Value -> Parser a) -> D.Value (V.Vector a)+jsonVec parser =+ D.array (D.arrayDimension V.replicateM $ D.arrayValue $ jsonD' parser)++jsonD' :: (Value -> Parser a) -> D.Value a+jsonD' parser =+ D.jsonBytes $ \raw ->+ do v <-+ first (\pError -> T.pack (pError ++ ": Value was: " ++ show raw)) $+ eitherDecodeStrict' raw+ first (\pError -> T.pack (pError ++ ": Value was: " ++ show v)) $ parseEither parser v