mysql-simple-typed (empty) → 0.1.0.0

raw patch · 7 files changed

+245/−0 lines, 7 filesdep +basedep +haskell-src-metadep +mysqlsetup-changed

Dependencies added: base, haskell-src-meta, mysql, mysql-simple, template-haskell, typedquery, utf8-string

Files

LICENSE +30/−0
README.md +3/−0
Setup.hs +2/−0
mysql-simple-typed.cabal +38/−0
src/Database/MySQL/Simple/DBmore.hs +72/−0
src/Database/MySQL/Simple/DBmoreTH.hs +61/−0
src/Database/MySQL/Simple/TypedQuery.hs +39/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2014, Marcin Tolysz++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 Marcin Tolysz 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,3 @@+mysql-simple-typed+==================+more: https://github.com/tolysz/typedquery

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ mysql-simple-typed.cabal view

@@ -0,0 +1,38 @@+-- Initial mysql-simple-typed.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                mysql-simple-typed+version:             0.1.0.0+synopsis:            Typed extension to mysql simple+description:         Simplifies simple+homepage:            https://github.com/tolysz/mysql-simple-typed+license:             BSD3+license-file:        LICENSE+author:              Marcin Tolysz+maintainer:          tolysz@gmail.com+-- copyright:           +category:            Database+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:     Database.MySQL.Simple.DBmore+                       Database.MySQL.Simple.DBmoreTH+                       Database.MySQL.Simple.TypedQuery+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.7 && <4.8+               ,       mysql+               ,       mysql-simple+               ,       typedquery+               ,       template-haskell+               ,       haskell-src-meta+--               ,       parsec+--               ,       aeson+--               ,       bytestring+--               ,       text+--               ,       transformers+               ,       utf8-string+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Database/MySQL/Simple/DBmore.hs view

@@ -0,0 +1,72 @@+{-# Language TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Database.MySQL.Simple.DBmore where++import Database.MySQL.Simple.DBmoreTH++qp 11+qp 12+qp 13+qp 14+qp 15+qp 16+qp 17+qp 18+qp 19+qp 20+qp 21+qp 22+qp 23+qp 24+qp 25++qr 11+qr 12+qr 13+qr 14+qr 15+qr 16+qr 17+qr 18+qr 19+qr 20+qr 21+qr 22+qr 23+qr 24+qr 25+qr 26+qr 27+qr 28+qr 29+qr 30+qr 31+qr 32+qr 33+qr 34+qr 35+qr 36+qr 37+qr 38+qr 39+qr 40+qr 41+qr 42+qr 43+qr 44+qr 45+qr 46+qr 47+qr 48+qr 49+qr 50+qr 51+qr 52+qr 53+qr 54+qr 55+qr 56+qr 57+qr 58+qr 59

+ src/Database/MySQL/Simple/DBmoreTH.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE TupleSections+           , OverloadedStrings+           , ScopedTypeVariables+           , NoMonomorphismRestriction+           , BangPatterns+           , TemplateHaskell+           , LambdaCase+  #-}+module Database.MySQL.Simple.DBmoreTH+( qp+, qr+)+where++import Database.MySQL.Base ()+import Database.MySQL.Simple.QueryParams+import Database.MySQL.Simple.Param+import Database.MySQL.Simple.Result+import Database.MySQL.Simple.QueryResults+++import Language.Haskell.TH.Syntax+import Control.Monad++import Language.Haskell.Meta.Parse()++import Prelude (map, (!!), (<), (-), (.) ,($), head, otherwise, zipWith3, Int, toInteger)++-- maybe add case 0 + 1 and make it being generated++qp :: Int -> Q [Dec]+qp k =  do+    ns <- replicateM k (newName "a")+    let pre = map (\x -> ClassP (''Param) [VarT x]) ns+    return [ InstanceD pre (loop k ns) [fun ns] ]+       where+         loop 0 ns = AppT (TupleT k) (VarT (head ns))+         loop i ns | i < k = AppT (loop (i-1) ns ) (VarT (ns !! i))+                   | otherwise = AppT (ConT ''QueryParams) (loop (i-1) ns )+         fun ns = FunD ('renderParams) [ Clause [TupP (map VarP ns)] (NormalB $ ListE $ map (AppE (VarE 'render) . VarE) ns ) [] ] ++qr :: Int -> Q [Dec]+qr k =  do+    nsa <- replicateM k (newName "a")+    nsv <- replicateM k (newName "v")+    nsf <- replicateM k (newName "f")+    fs <- newName "fs"+    vs <- newName "vs"++    let pre = map (\x -> ClassP (''Result) [VarT x]) nsa+    return [ InstanceD pre (loop k nsa) [fun nsa nsf nsv fs vs] ]+       where+         loop 0 ns = AppT (TupleT k) (VarT (head ns))+         loop i ns | i < k = AppT (loop (i-1) ns ) (VarT (ns !! i))+                   | otherwise = AppT (ConT ''QueryResults) (loop (i-1) ns )+         fun nsa nsf nsv fs vs= FunD ('convertResults) +                             [ Clause [ListP (map VarP nsf), ListP (map VarP nsv)] +                                  (NormalB $ TupE $ map VarE nsa )+                                     (zipWith3 (\a f v -> ValD (BangP (VarP a)) (NormalB (AppE (AppE (VarE 'convert) (VarE f)) (VarE v))) [] ) nsa nsf nsv)+                             , Clause [VarP fs,VarP vs] (NormalB (AppE (AppE (AppE (VarE 'convertError) (VarE fs)) (VarE vs)) (LitE $ IntegerL $ toInteger k))) []+                             ]

+ src/Database/MySQL/Simple/TypedQuery.hs view

@@ -0,0 +1,39 @@+{-# Language TemplateHaskell #-}++module Database.MySQL.Simple.TypedQuery+( genJsonQuery+, genTypedQuery+, TQ.genUncurry+, TQ.TypedQuery(..)+, S.Query+)+where++import qualified Database.MySQL.Base         as S (Connection)+import qualified Database.MySQL.Simple.Types as S (fromQuery)+import qualified Database.MySQL.Simple       as S (query, query_, execute, execute_, Only(..), In(..), connect, Query)+import Database.MySQL.Simple.DBmore()+import qualified Database.TypedQuery.Types as TQ+import Language.Haskell.TH.Syntax (Q, Exp, Lift(..))+import Data.ByteString.UTF8 (toString)+import Prelude ( (.))+++-- Move this somewhere+instance Lift S.Query where+  lift = lift . toString . S.fromQuery++instance TQ.RunDB S.Query where+  rdquery  _   = 'S.query+  rdquery_ _   = 'S.query_+  rdexecute_ _ = 'S.execute_+  rdexecute  _ = 'S.execute+  rdin       _ = 'S.In+  rdonly     _ = 'S.Only+  rdconn     _ = ''S.Connection++genJsonQuery :: TQ.TypedQuery S.Query -> Q Exp+genJsonQuery = TQ.genJsonQuery++genTypedQuery :: TQ.TypedQuery S.Query -> Q Exp+genTypedQuery = TQ.genTypedQuery