sqlite-simple-typed (empty) → 0.1.0.0
raw patch · 12 files changed
+369/−0 lines, 12 filesdep +basedep +haskell-src-metadep +sqlitesetup-changed
Dependencies added: base, haskell-src-meta, sqlite, sqlite-simple, template-haskell, typedquery, utf8-string
Files
- LICENSE +30/−0
- README.md +3/−0
- Setup.hs +2/−0
- example/LICENSE +30/−0
- example/README.md +5/−0
- example/Setup.hs +2/−0
- example/example-sqlite-simple-typed.cabal +27/−0
- example/src/Main.hs +30/−0
- sqlite-simple-typed.cabal +45/−0
- src/Database/SQLite/Simple/DBmore.hs +73/−0
- src/Database/SQLite/Simple/DBmoreTH.hs +64/−0
- src/Database/SQLite/Simple/TypedQuery.hs +58/−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
+ example/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.
+ example/README.md view
@@ -0,0 +1,5 @@+Lets follow:++https://hackage.haskell.org/package/sqlite-simple-0.1.0.2/docs/Database-SQLite-Simple.html++ sqlite3 test.db "CREATE TABLE test (id INTEGER PRIMARY KEY, str text); INSERT INTO test (str) VALUES ('test string');"
+ example/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/example-sqlite-simple-typed.cabal view
@@ -0,0 +1,27 @@+-- Initial example-sqlite-simple-typed.cabal generated by cabal init. For +-- further documentation, see http://haskell.org/cabal/users-guide/++name: example-sqlite-simple-typed+version: 0.1.0.0+-- synopsis: +-- description: +license: BSD3+license-file: LICENSE+author: Marcin Tolysz+maintainer: tolysz@gmail.com+-- copyright: +category: Database+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++executable example-sqlite-simple-typed+ main-is: Main.hs+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.8+ , sqlite-simple-typed+ , sqlite-simple+ , rawstring-qm+ hs-source-dirs: src+ default-language: Haskell2010
+ example/src/Main.hs view
@@ -0,0 +1,30 @@+ {-# LANGUAGE OverloadedStrings+ , TemplateHaskell+ , QuasiQuotes+ #-}+module Main where++import Database.SQLite.Simple+import Database.SQLite.Simple.TypedQuery+import Data.String.QM++hello = $(genTypedQuery [qq|select (2 + 2) as sum -- Int |]) =<< open "test.db"++hello2 = $(genTypedQuery [qq|+ select id -- Int+ , str -- String+ from test+ |] ) =<< open "test.db"++ins = flip $(genTypedQuery [qq|+ INSERT INTO + test ( str -- String+ )+ |] ) "test string 2" =<< open "test.db"+++main = do+ ins+ putStrLn "Me say hallo"+ print =<< hello+ print =<< hello2
+ sqlite-simple-typed.cabal view
@@ -0,0 +1,45 @@+-- Initial mysql-simple-typed.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: sqlite-simple-typed+version: 0.1.0.0+synopsis: Typed extension to sqlite simple+description: Simplifies Simple+homepage: https://github.com/tolysz/sqlite-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+ , example/example-sqlite-simple-typed.cabal+ , example/LICENSE+ , example/README.md+ , example/Setup.hs+ , example/src/Main.hs++cabal-version: >=1.10++library+ exposed-modules: Database.SQLite.Simple.DBmore+ Database.SQLite.Simple.DBmoreTH+ Database.SQLite.Simple.TypedQuery+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.8+ , sqlite+ , sqlite-simple+ , typedquery+ , template-haskell+ , haskell-src-meta+-- , parsec+-- , aeson+-- , bytestring+-- , text+-- , transformers+ , utf8-string+ hs-source-dirs: src+ default-language: Haskell2010+
+ src/Database/SQLite/Simple/DBmore.hs view
@@ -0,0 +1,73 @@+{-# Language TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Database.SQLite.Simple.DBmore where++import Database.SQLite.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/SQLite/Simple/DBmoreTH.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TupleSections+ , OverloadedStrings+ , ScopedTypeVariables+ , NoMonomorphismRestriction+ , BangPatterns+ , TemplateHaskell+ , LambdaCase+ #-}+module Database.SQLite.Simple.DBmoreTH where+{--+( qp+, qr+)+where++import Database.SQLite.Base ()+import Database.SQLite.Simple.ToRow+import Database.SQLite.Simple.ToField+import Database.SQLite.Simple.FromField+import Database.SQLite.Simple.FromRow+++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 (''Field) [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 ''ToField) (loop (i-1) ns )+ fun ns = FunD ('toRow) [ Clause [TupP (map VarP ns)] (NormalB $ ListE $ map (AppE (VarE 'toField) . 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 ('fromRow) + [ 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 'fromField) (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/SQLite/Simple/TypedQuery.hs view
@@ -0,0 +1,58 @@+{-# Language TemplateHaskell #-}++module Database.SQLite.Simple.TypedQuery+( genJsonQuery+, genTypedQuery+, TQ.genUncurry+, TQ.TypedQuery(..)+, S.Query+)+where++import qualified Database.SQLite.Simple.Internal as S -- (Connection)+import qualified Database.SQLite.Simple.Types as S -- (fromQuery)+import qualified Database.SQLite.Simple as S -- (query, query_, execute, execute_, Only(..), In(..), connect, Query)+import Database.SQLite.Simple.DBmore()+import qualified Database.TypedQuery.Types as TQ+import Language.Haskell.TH.Syntax (Q, Exp, Lift(..))+-- import Data.ByteString.UTF8 (toString)+import Prelude ( (.), id)+++ +-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))+{-- +newtype In a = In a+ deriving (Eq, Ord, Read, Show, Typeable, Functor)++instance (Param a) => Param (In [a]) where+ toRow (In []) = toRow [S.Null]+ toRow (In xs) = toRow xs+--}+-- Plain (fromChar '(') :+-- (intersperse (Plain (fromChar ',')) . map toRow $ xs) +++-- [Plain (fromChar ')')]++{--+-- | Wrap a mostly-binary string to be escaped in hexadecimal.+newtype Binary a = Binary a+ deriving (Eq, Ord, Read, Show, Typeable, Functor)+--}+-- Move this somewhere+instance Lift S.Query where+ lift = lift . S.fromQuery++instance TQ.RunDB S.Query where+ rdquery _ = 'S.query+ rdquery_ _ = 'S.query_+ rdexecute_ _ = 'S.execute_+ rdexecute _ = 'S.execute+ rdin _ = 'id+ 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