packages feed

hasql-class (empty) → 0.0.0.0

raw patch · 9 files changed

+432/−0 lines, 9 filesdep +Globdep +QuickCheckdep +basesetup-changed

Dependencies added: Glob, QuickCheck, base, bytestring, containers, contravariant, data-default-class, doctest, generics-eot, hasql, hasql-class, hspec, process, quickcheck-instances, string-qq, text, time, vector, yaml

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Julian K. Arni (c) 2015++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 Julian K. Arni 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hasql-class.cabal view
@@ -0,0 +1,98 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           hasql-class+version:        0.0.0.0+synopsis:       Encodable and Decodable classes for hasql+description:    Please see README.md+category:       Hasql, Database, PostgreSQL+homepage:       http://github.com/jkarni/hasql-class#readme+bug-reports:    https://github.com/turingjmp/hasql-class/issues+author:         Julian K. Arni+maintainer:     jkarni@gmail.com+copyright:      (c) Julian K. Arni+license:        BSD3+license-file:   LICENSE+tested-with:    GHC == 7.10.3+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/turingjmp/hasql-class++library+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances OverloadedStrings ScopedTypeVariables+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , text+    , bytestring+    , vector+    , time >= 1.4 && < 1.6+    , data-default-class == 0.0.*+    , contravariant == 1.4.*+    , hasql >= 0.19.11 && < 0.20+    , generics-eot == 0.2.*+  exposed-modules:+      Hasql.Class+      Hasql.Class.Internal.Decodable+      Hasql.Class.Internal.Encodable+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: Doctest.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances OverloadedStrings ScopedTypeVariables+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , text+    , bytestring+    , vector+    , time >= 1.4 && < 1.6+    , data-default-class == 0.0.*+    , contravariant == 1.4.*+    , hasql >= 0.19.11 && < 0.20+    , generics-eot == 0.2.*+    , doctest >= 0.9 && < 0.12+    , Glob >= 0.7 && < 0.8+    , containers == 0.5.*+    , yaml == 0.8.*+  other-modules:+      Hasql.ClassSpec+      Spec+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances OverloadedStrings ScopedTypeVariables+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , text+    , bytestring+    , vector+    , time >= 1.4 && < 1.6+    , data-default-class == 0.0.*+    , contravariant == 1.4.*+    , hasql >= 0.19.11 && < 0.20+    , generics-eot == 0.2.*+    , hasql-class+    , hspec > 2 && < 3+    , string-qq == 0.0.*+    , QuickCheck >= 2.8 && < 2.9+    , process > 1.2 && < 2+    , quickcheck-instances == 0.3.*+  other-modules:+      Doctest+      Hasql.ClassSpec+  default-language: Haskell2010
+ src/Hasql/Class.hs view
@@ -0,0 +1,46 @@+module Hasql.Class+  (+  -- * Query helpers+  --+  -- | Utility functions for `Query`s. The @ByteString@ argument is the SQL, and+  -- the @Bool@ argument is whether to use prepared statements.+    stmtList+  , stmtUnit+  , stmtVector+  , stmtMaybe+  -- * Classes+  ,  Encodable(..)+  , Decodable(..)+  ) where++import Hasql.Class.Internal.Encodable+import Hasql.Class.Internal.Decodable++import Data.Vector (Vector)+import Data.ByteString (ByteString)+import Hasql.Query+import Hasql.Decoders (rowsList, unit, maybeRow, rowsVector)++-- | Make a `Query` that returns a `Vector` of values+--+-- Faster than `stmtList`.+stmtVector :: (Encodable a, Decodable b) => ByteString -> Bool -> Query a (Vector b)+stmtVector query isPrepared = statement query encode (rowsVector decode) isPrepared++-- | Make a `Query` that @Maybe@ returns a value+stmtMaybe :: (Encodable a, Decodable b) => ByteString -> Bool -> Query a (Maybe b)+stmtMaybe query isPrepared = statement query encode (maybeRow decode) isPrepared++-- | Make a `Query` that returns a list of values+--+-- > getPeople :: Query () Person+-- > getPeople = stmtList "SELECT * FROM person" True+stmtList :: (Encodable a, Decodable b) => ByteString -> Bool -> Query a [b]+stmtList query isPrepared = statement query encode (rowsList decode) isPrepared++-- | Make a `Query` that returns @()@ (no result).+--+-- > insertVal :: Query Text ()+-- > insertVal = stmtUnit "INSERT INTO tbl VALUES ($1)" True+stmtUnit :: (Encodable a) => ByteString -> Bool -> Query a ()+stmtUnit query isPrepared = statement query encode unit isPrepared
+ src/Hasql/Class/Internal/Decodable.hs view
@@ -0,0 +1,74 @@+module Hasql.Class.Internal.Decodable where++import Data.Default.Class (def)+import qualified Hasql.Decoders as Hasql+import Data.Time+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Int+import Generics.Eot++-- | Datatypes that can be encoded as `hasql` PostgreSQL parameters.  This+-- class can be generically derived.+--+--   #SINCE#+class Decodable a where+  decode :: Hasql.Row a+  default decode :: (HasEot a, GDecodable (Eot a)) => Hasql.Row a+  decode = fromEot <$> gdecode++-- | #SINCE#+instance Decodable Char where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Bool where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Int16 where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Int32 where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Int64 where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Double where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Float where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Text where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable ByteString where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable DiffTime where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable UTCTime where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable Day where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable TimeOfDay where+  decode = Hasql.value def+-- | #SINCE#+instance Decodable LocalTime where+  decode = Hasql.value def++class GDecodable eot where+  gdecode :: Hasql.Row eot++instance (Decodable x, GDecodable xs)+  => GDecodable (x, xs) where+  gdecode = (,) <$> decode <*> gdecode++instance GDecodable () where+  gdecode = return ()++instance GDecodable x => GDecodable (Either x Void) where+  gdecode = Left <$> gdecode
+ src/Hasql/Class/Internal/Encodable.hs view
@@ -0,0 +1,80 @@+module Hasql.Class.Internal.Encodable where++import Data.Default.Class (def)+import qualified Hasql.Encoders as Hasql+import Data.Time (DiffTime, UTCTime, Day, TimeOfDay, LocalTime)+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Functor.Contravariant.Generic+import Data.Int (Int16, Int32, Int64)+import Data.Proxy (Proxy(..))++-- | Datatypes that can be encoded as `hasql` PostgreSQL parameters. This class+-- can be generically derived.+--+-- Note that the number of parameters is not necessarily the number of Haskell+-- values. For example+--+-- > data MyData = MyData { aChar :: Char, aText :: Text }+-- >  deriving (Eq, Show, Generic, Encodable)+-- >+-- > aData :: MyData+-- > aData = MyDate 'a' "ha!"+-- >+-- > -- Will only insert the char, and a NULL for the text value+-- > wrong = query aData stmtUnit "INSERT INTO myTable ($1)" True+-- >+-- > -- Will insert both the char and the text values+-- > right = query aData stmtUnit "INSERT INTO myTable ($1, $2)" True+--+-- #SINCE#+class Encodable a where+  encode :: Hasql.Params a+  default encode :: Deciding Encodable a => Hasql.Params a+  encode = deciding (Proxy :: Proxy Encodable) encode++-- | #SINCE#+instance Encodable () where+  encode = Hasql.unit+-- | #SINCE#+instance Encodable Char where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Bool where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Int16 where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Int32 where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Int64 where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Double where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Float where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Text where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable ByteString where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable DiffTime where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable UTCTime where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable Day where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable TimeOfDay where+  encode = Hasql.value def+-- | #SINCE#+instance Encodable LocalTime where+  encode = Hasql.value def
+ test/Doctest.hs view
@@ -0,0 +1,26 @@+module Main (main) where++-- Runs doctest on all files in "src" dir. Assumes:+--   (a) You are using hpack+--   (b) The top-level "default-extensions" are the only extensions besides the+--   ones in the files.++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)+import Data.Yaml++newtype Exts = Exts { getExts :: [String] }+  deriving (Eq, Show, Read)++instance FromJSON Exts where+  parseJSON (Object v) = Exts <$> v .: "default-extensions"+  parseJSON _ = fail "expecting object"++main :: IO ()+main = do+  hpack' <- decodeFile "package.yaml"+  hpack <- case hpack' of+    Nothing -> return $ Exts []+    Just v  -> return v+  files <- glob "src/**/*.hs"+  doctest $ files ++ fmap ("-X" ++) (getExts hpack)
+ test/Hasql/ClassSpec.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+module Hasql.ClassSpec (spec) where++import Data.String.QQ (s)+import Data.Int+import Data.Text (Text)+import qualified Data.Text as Text+import GHC.Generics (Generic)+import Hasql.Connection (acquire, release)+import Hasql.Session (query, Session, Error, sql, run)+import System.Process (callCommand)+import Test.Hspec (describe, it, Spec, shouldBe)+import Test.QuickCheck (Arbitrary(..), property, (==>))+import Test.QuickCheck.Instances ()++import Hasql.Class++spec :: Spec+spec = describe "Encodable" $ do++  it "works for the generic instance"+    $ property $ \(test :: Test) -> noNullBytes test ==> do+      result <- withDB $ do+        () <- query test $ stmtUnit [s|+          INSERT INTO hasql_class_test_table+          VALUES ($1, $2, $3, $4) |] True+        query () $ stmtList "SELECT * FROM hasql_class_test_table" True+      result `shouldBe` Right [test]+++-- postgres drops null bytes+noNullBytes :: Test -> Bool+noNullBytes t+  = not (Text.any (== '\NUL') $ t_text t)+  && not (t_char t == '\NUL')+++data Test = Test+   { t_int  :: Int16+   , t_text :: Text+   , t_char :: Char+   , t_bool :: Bool+   } deriving (Eq, Show, Read, Generic, Encodable, Decodable)++instance Arbitrary Test where+  arbitrary = Test <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++withDB :: Session b -> IO (Either Error b)+withDB sess = do+   callCommand createCmd+   conn <- acquire info >>= \i -> case i of+     Left err -> error $ show err+     Right v -> return v+   result <- flip run conn $ do+     sql createTbl+     s' <- sess+     sql deleteTbl+     return s'+   release conn+   return result+  where+    info = "dbname=hasql-class-test"+    createCmd = "createdb hasql-class-test >/dev/null 2>/dev/null || true"+    createTbl = [s|+      CREATE TABLE IF NOT EXISTS hasql_class_test_table (+          t_int  integer NOT NULL,+          t_text text    NOT NULL,+          t_char char    NOT NULL,+          t_bool bool    NOT NULL+      )+      |]+    deleteTbl = "DROP TABLE hasql_class_test_table "
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}