opaleye-sqlite 0.0.0.1 → 0.0.1.0

raw patch · 9 files changed

+118/−43 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +0/−4
• Test/QuickCheck.hs +31/−18
• opaleye-sqlite.cabal +3/−3
• src/Opaleye/SQLite.hs +2/−0
• src/Opaleye/SQLite/Constant.hs +70/−0
• src/Opaleye/SQLite/Internal/HaskellDB/Sql/Print.hs +9/−11
• src/Opaleye/SQLite/Internal/PGTypes.hs +1/−1
• src/Opaleye/SQLite/Internal/Sql.hs +2/−2
• src/Opaleye/SQLite/SqlTypes.hs +0/−4

@@ -1,4 +0,0 @@-# `opaleye-sqlite`--A preliminary version of Opaleye for SQLite.  There may be many rough-edges!

@@ -35,8 +35,11 @@ type Columns = [Either (O.Column O.PGInt4) (O.Column O.PGBool)] type Haskells = [Either Int Bool] +columnsOfHaskells :: Haskells -> Columns+columnsOfHaskells = O.constantExplicit eitherPP+ newtype ArbitraryQuery   = ArbitraryQuery (O.Query Columns)-newtype ArbitraryColumns = ArbitraryColumns { unArbitraryColumns :: Columns }+newtype ArbitraryColumns = ArbitraryColumns { unArbitraryColumns :: Haskells }                         deriving Show newtype ArbitraryPositiveInt = ArbitraryPositiveInt Int                             deriving Show@@ -62,7 +65,7 @@ arbitraryQuery :: Int -> TQ.Gen ArbitraryQuery arbitraryQuery size | size == 0 = (pure . ArbitraryQuery . pure) []                     | otherwise = TQ.oneof [-      (ArbitraryQuery . pure . unArbitraryColumns)+      (ArbitraryQuery . pure . columnsOfHaskells . unArbitraryColumns)         <$> TQ.arbitrary     , return (ArbitraryQuery (fmap (\(x,y) -> [Left x, Left y]) (O.queryTable table1)))     , do@@ -107,7 +110,7 @@ instance TQ.Arbitrary ArbitraryColumns where     arbitrary = do     l <- TQ.listOf (TQ.oneof (map (return . Left) [-1, 0, 1]-                             ++ map (return . Right) [O.pgBool False, O.pgBool True]))+                             ++ map (return . Right) [False, True]))     return (ArbitraryColumns l)  instance TQ.Arbitrary ArbitraryPositiveInt where@@ -221,6 +224,11 @@  -- { The tests +columns :: PGS.Connection -> ArbitraryColumns -> IO Bool+columns conn (ArbitraryColumns c) =+  compareNoSort conn (denotation' (pure (columnsOfHaskells c)))+                     (pure c)+ fmap' :: PGS.Connection -> ArbitraryGarble -> ArbitraryQuery -> IO Bool fmap' conn f (ArbitraryQuery q) = do   compareNoSort conn (denotation' (fmap (unArbitraryGarble f) q))@@ -262,29 +270,34 @@  run :: PGS.Connection -> IO () run conn = do-  let propFmap      = (fmap . fmap) TQ.ioProperty (fmap' conn)-      propApply     = (fmap . fmap) TQ.ioProperty (apply conn)-      propLimit     = (fmap . fmap) TQ.ioProperty (limit conn)---      propOffset    = (fmap . fmap) TQ.ioProperty (offset conn)-      propOrder     = (fmap . fmap) TQ.ioProperty (order conn)-      propDistinct  = fmap          TQ.ioProperty (distinct conn)-      propRestrict  = fmap          TQ.ioProperty (restrict conn)+  let prop1 p = fmap          TQ.ioProperty (p conn)+      prop2 p = (fmap . fmap) TQ.ioProperty (p conn) +      test1 :: (Show a, TQ.Arbitrary a, TQ.Testable prop)+               => (PGS.Connection -> a -> IO prop) -> IO ()+      test1 = t . prop1++      test2 :: (Show a1, Show a2, TQ.Arbitrary a1, TQ.Arbitrary a2,+                TQ.Testable prop)+               => (PGS.Connection -> a1 -> a2 -> IO prop) -> IO ()+      test2 = t . prop2+   -- 5 seems to be the max size of test cases before SQLite's stack overflows.   -- I'd rather increase the stack size   --   http://www.sqlite.org/limits.html#max_expr_depth   -- but I don't know how to do that from Haskell.   -- Increasing the number of trials to compensate.-  let t p = errorIfNotSuccess =<< TQ.quickCheckWithResult (TQ.stdArgs { TQ.maxSuccess = 10000+      t p = errorIfNotSuccess =<< TQ.quickCheckWithResult (TQ.stdArgs { TQ.maxSuccess = 10000                                                                       , TQ.maxSize    = 5 }) p -  t propFmap-  t propApply-  t propLimit---  t propOffset-  t propOrder-  t propDistinct-  t propRestrict+  test1 columns+  test2 fmap'+  test2 apply+  test2 limit+--  test2 offset+  test2 order+  test1 distinct+  test1 restrict  -- } 

@@ -1,6 +1,6 @@ name:            opaleye-sqlite copyright:       Copyright (c) 2014-2015 Purely Agile Limited-version:         0.0.0.1+version:         0.0.1.0 synopsis:        An SQL-generating DSL targeting SQLite description:     An SQL-generating DSL targeting SQLite.  Allows                  SQLite queries to be written within Haskell in a@@ -14,8 +14,7 @@ category:        Database build-type:      Simple cabal-version:   >= 1.8-extra-doc-files: *.md,-                 Doc/*.md+extra-doc-files: Doc/*.md tested-with:     GHC==7.10.1, GHC==7.8.4, GHC==7.6.3  source-repository head@@ -46,6 +45,7 @@                    Opaleye.SQLite.Aggregate,                    Opaleye.SQLite.Binary,                    Opaleye.SQLite.Column,+                   Opaleye.SQLite.Constant,                    Opaleye.SQLite.Distinct,                    Opaleye.SQLite.Join,                    Opaleye.SQLite.Manipulation,

@@ -1,6 +1,7 @@ module Opaleye.SQLite ( module Opaleye.SQLite.Aggregate                , module Opaleye.SQLite.Binary                , module Opaleye.SQLite.Column+               , module Opaleye.SQLite.Constant                , module Opaleye.SQLite.Distinct                , module Opaleye.SQLite.Join                , module Opaleye.SQLite.Manipulation@@ -17,6 +18,7 @@ import Opaleye.SQLite.Aggregate import Opaleye.SQLite.Binary import Opaleye.SQLite.Column+import Opaleye.SQLite.Constant import Opaleye.SQLite.Distinct import Opaleye.SQLite.Join import Opaleye.SQLite.Manipulation

@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}++module Opaleye.SQLite.Constant where++import           Opaleye.SQLite.Column           (Column)+import qualified Opaleye.SQLite.Column           as C+import qualified Opaleye.SQLite.SqlTypes         as T++import qualified Data.Text                       as ST+import qualified Data.Text.Lazy                  as LT++import qualified Data.Profunctor.Product         as PP+import           Data.Profunctor.Product         (empty, (***!), (+++!))+import qualified Data.Profunctor.Product.Default as D+import qualified Data.Profunctor                 as P++import           Control.Applicative (Applicative, pure, (<*>))+++newtype Constant haskells columns =+  Constant { constantExplicit :: haskells -> columns }++constant :: D.Default Constant haskells columns+         => haskells -> columns+constant = constantExplicit D.def++instance D.Default Constant haskell (Column sql)+         => D.Default Constant (Maybe haskell) (Column (C.Nullable sql)) where+  def = Constant (C.maybeToNullable . fmap f)+    where Constant f = D.def++instance D.Default Constant Int (Column T.SqlInt) where+  def = Constant T.sqlInt++instance D.Default Constant String (Column T.SqlText) where+  def = Constant T.sqlString++instance D.Default Constant ST.Text (Column T.SqlText) where+  def = Constant T.sqlStrictText++instance D.Default Constant LT.Text (Column T.SqlText) where+  def = Constant T.sqlLazyText++instance D.Default Constant Double (Column T.SqlReal) where+  def = Constant T.sqlReal++instance D.Default Constant Bool (Column T.SqlBool) where+  def = Constant T.sqlBool+++-- { Boilerplate instances++instance Functor (Constant a) where+  fmap f (Constant g) = Constant (fmap f g)++instance Applicative (Constant a) where+  pure = Constant . pure+  Constant f <*> Constant x = Constant (f <*> x)++instance P.Profunctor Constant where+  dimap f g (Constant h) = Constant (P.dimap f g h)++instance PP.ProductProfunctor Constant where+  empty = Constant empty+  Constant f ***! Constant g = Constant (f ***! g)++instance PP.SumProfunctor Constant where+  Constant f +++! Constant g = Constant (f +++! g)++-- }

@@ -3,6 +3,7 @@ -- License     :  BSD-style  module Opaleye.SQLite.Internal.HaskellDB.Sql.Print (+                                     deliteral,                                      ppUpdate,                                      ppDelete,                                      ppInsert,@@ -27,6 +28,11 @@                                   empty, equals, hcat, hsep, parens, punctuate,                                   text, vcat) +-- Silliness to avoid "ORDER BY 1" etc. meaning order by the first column+-- Any identity function will do+deliteral :: SqlExpr -> SqlExpr+deliteral c@(ColumnSqlExpr (SqlColumn _)) = c+deliteral expr = FunSqlExpr "COALESCE" [expr, expr]  ppWhere :: [SqlExpr] -> Doc ppWhere [] = empty@@ -38,14 +44,7 @@ ppGroupBy es = text "GROUP BY" <+> ppGroupAttrs es   where     ppGroupAttrs :: [SqlExpr] -> Doc-    ppGroupAttrs cs = commaV nameOrExpr cs-    nameOrExpr :: SqlExpr -> Doc-    nameOrExpr (ColumnSqlExpr (SqlColumn col)) = text col-    -- Silliness to avoid "ORDER BY 1" etc. meaning order by the first column-    -- Any identity function will do-    --  nameOrExpr expr = parens (ppSqlExpr expr)-    -- SQLite requires COALESCE to have at least two arguments.-    nameOrExpr expr = text "COALESCE" <+> parens (commaH ppSqlExpr [expr, expr])+    ppGroupAttrs cs = commaV (ppSqlExpr . deliteral) cs  ppOrderBy :: [(SqlExpr,SqlOrder)] -> Doc ppOrderBy [] = empty@@ -54,8 +53,7 @@     -- Silliness to avoid "ORDER BY 1" etc. meaning order by the first column     -- Any identity function will do     --   ppOrd (e,o) = ppSqlExpr e <+> ppSqlDirection o <+> ppSqlNulls o-      ppOrd (e,o) = text "COALESCE"-                      <+> parens (commaH ppSqlExpr [e, e])+      ppOrd (e,o) = ppSqlExpr (deliteral e)                       <+> ppSqlDirection o                       <+> ppSqlNulls o @@ -66,7 +64,7 @@  -- FIXME: We haven't implemented NULL ordering properly ppSqlNulls :: Sql.SqlOrder -> Doc-ppSqlNulls x = empty+ppSqlNulls _ = empty --ppSqlNulls x = text $ case Sql.sqlOrderNulls x of --        Sql.SqlNullsFirst -> "NULLS FIRST" --        Sql.SqlNullsLast  -> "NULLS LAST"

@@ -15,7 +15,7 @@ -- FIXME: SQLite requires temporal types to have the type "TEXT" which -- may cause problems elsewhere. unsafePgFormatTime :: Time.FormatTime t => HPQ.Name -> String -> t -> Column c-unsafePgFormatTime typeName formatString = castToType "TEXT" . format+unsafePgFormatTime _typeName formatString = castToType "TEXT" . format   where format = Time.formatTime Locale.defaultTimeLocale formatString  literalColumn :: HPQ.Literal -> Column a

@@ -8,6 +8,7 @@ import           Opaleye.SQLite.Internal.HaskellDB.PrimQuery (Symbol(Symbol)) import qualified Opaleye.SQLite.Internal.HaskellDB.Sql as HSql import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Default as SD+import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Print as SP import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Generate as SG import qualified Opaleye.SQLite.Internal.Tag as T @@ -101,8 +102,7 @@         --- constant.         handleEmpty :: [HSql.SqlExpr] -> NEL.NonEmpty HSql.SqlExpr         handleEmpty =-          M.fromMaybe (return (HSql.FunSqlExpr "COALESCE" [HSql.ConstSqlExpr "0"-                                                          ,HSql.ConstSqlExpr "0"]))+          M.fromMaybe (return (SP.deliteral (HSql.ConstSqlExpr "0")))           . NEL.nonEmpty          groupBy' :: [(symbol, (Maybe aggrOp, HPQ.PrimExpr))]

@@ -4,13 +4,9 @@  import           Opaleye.SQLite.Internal.Column (Column) import qualified Opaleye.SQLite.PGTypes as PT-import qualified Opaleye.SQLite.Internal.PGTypes as IPT -import qualified Opaleye.SQLite.Internal.HaskellDB.PrimQuery as HPQ- import qualified Data.Text as SText import qualified Data.Text.Lazy as LText-import qualified Data.Time as Time  -- These probably don't correspond very well to SQLite types yet. -- Work in progress.