diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +mysql-simple-typed +================== +more: https://github.com/tolysz/typedquery diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example/LICENSE b/example/LICENSE new file mode 100644 --- /dev/null +++ b/example/LICENSE @@ -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. diff --git a/example/README.md b/example/README.md new file mode 100644 --- /dev/null +++ b/example/README.md @@ -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');" diff --git a/example/Setup.hs b/example/Setup.hs new file mode 100644 --- /dev/null +++ b/example/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example/example-sqlite-simple-typed.cabal b/example/example-sqlite-simple-typed.cabal new file mode 100644 --- /dev/null +++ b/example/example-sqlite-simple-typed.cabal @@ -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 diff --git a/example/src/Main.hs b/example/src/Main.hs new file mode 100644 --- /dev/null +++ b/example/src/Main.hs @@ -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 diff --git a/sqlite-simple-typed.cabal b/sqlite-simple-typed.cabal new file mode 100644 --- /dev/null +++ b/sqlite-simple-typed.cabal @@ -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 + diff --git a/src/Database/SQLite/Simple/DBmore.hs b/src/Database/SQLite/Simple/DBmore.hs new file mode 100644 --- /dev/null +++ b/src/Database/SQLite/Simple/DBmore.hs @@ -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 +--} diff --git a/src/Database/SQLite/Simple/DBmoreTH.hs b/src/Database/SQLite/Simple/DBmoreTH.hs new file mode 100644 --- /dev/null +++ b/src/Database/SQLite/Simple/DBmoreTH.hs @@ -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))) [] + ] + +--} diff --git a/src/Database/SQLite/Simple/TypedQuery.hs b/src/Database/SQLite/Simple/TypedQuery.hs new file mode 100644 --- /dev/null +++ b/src/Database/SQLite/Simple/TypedQuery.hs @@ -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