DSH 0.5.3 → 0.5.5

raw patch · 5 files changed

+225/−113 lines, 5 filesdep ~FerryCoredep ~PathfinderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: FerryCore, Pathfinder

API changes (from Hackage documentation)

Files

• DSH.cabal +3/−3
• src/Database/DSH.hs +2/−0
• src/Database/DSH/Combinators.hs +32/−7
• src/Database/DSH/Data.hs +30/−10
• tests/Main.hs +158/−93

@@ -1,5 +1,5 @@ Name:                DSH-Version:             0.5.3+Version:             0.5.5 Synopsis:            Database Supported Haskell Description:   This is a Haskell library for database-supported program execution. Using@@ -65,8 +65,8 @@                      syntax-trees       >= 0.1.2,                      HaXml              >= 1.20,                      csv                >= 0.1,-                     Pathfinder         >= 0.5,-                     FerryCore          >= 0.4+                     Pathfinder         >= 0.5.6,+                     FerryCore          >= 0.4.6.1    Hs-Source-Dirs:    src 

@@ -90,10 +90,12 @@   , break   , elem   , notElem+  , lookup   , zip   , zipWith   , unzip   , fst   , snd   , maybe+  , either   )

@@ -8,7 +8,7 @@  import Data.Convertible -import Prelude (Eq, Ord, Num, Bool(..), Integer, Double, Maybe, undefined, error, ($))+import Prelude (Eq, Ord, Num, Bool(..), Integer, Double, Maybe, Either, undefined, error, ($), (.))  -- * Unit @@ -121,11 +121,37 @@ fromMaybe a ma = (isNothing ma) ? (a, fromJust (ma))  catMaybes :: QA a => Q [Maybe a] -> Q [a]-catMaybes mas = map fromJust (filter isJust mas)+catMaybes mas = concatMap maybeToList mas  mapMaybe :: (QA a, QA b) => (Q a -> Q (Maybe b)) -> Q [a] -> Q [b]-mapMaybe f as = catMaybes (map f as)+mapMaybe f as = concatMap (maybeToList . f) as +-- * Either++left :: (QA a,QA b) => Q a -> Q (Either a b)+left a = tupleToEither (tuple ((singleton a),nil))++right :: (QA a,QA b) => Q b -> Q (Either a b)+right a = tupleToEither (tuple (nil,(singleton a)))++isLeft :: (QA a,QA b) => Q (Either a b) -> Q Bool+isLeft = null . snd . eitherToTuple++isRight :: (QA a,QA b) => Q (Either a b) -> Q Bool+isRight = null . fst . eitherToTuple++either :: (QA a,QA b,QA c) => (Q a -> Q c) -> (Q b -> Q c) -> Q (Either a b) -> Q c+either lf rf e = (isLeft e) ? ((lf . head . fst . eitherToTuple) e,(rf . head . snd . eitherToTuple) e)++lefts :: (QA a,QA b) => Q [Either a b] -> Q [a]+lefts = concatMap (fst . eitherToTuple)++rights :: (QA a,QA b) => Q [Either a b] -> Q [b]+rights = concatMap (snd . eitherToTuple)++partitionEithers :: (QA a,QA b) => Q [Either a b] -> Q ([a], [b])+partitionEithers es = tuple (lefts es,rights es)+ -- * List Construction  nil :: forall a. (QA a) => Q [a]@@ -261,6 +287,9 @@ notElem :: forall a. (Eq a, QA a) => Q a -> Q [a] -> Q Bool notElem a as = not (elem a as) +lookup :: (QA a,QA b,Eq a) => Q a -> Q [(a, b)] -> Q (Maybe b)+lookup a  = listToMaybe . map snd . filter ((a ==) . fst)+ -- * Zipping and Unzipping Lists  zip       :: forall a b. (QA a, QA b) => Q [a] -> Q [b] -> Q [(a,b)]@@ -343,10 +372,6 @@ > words > unlines > unwords--Searching lists:--> lookup  Zipping and unzipping lists: 

@@ -84,8 +84,8 @@     TableDB   String [[String]]   | TableCSV  String   deriving (Eq, Ord, Show, Data, Typeable)-  -  ++ typeExp :: Exp -> Type typeExp e = case e of   UnitE t -> t@@ -174,13 +174,33 @@   fromNorm _ = $impossible  instance (QA a) => QA (Maybe a) where-  reify _ = ListT (reify (undefined :: a))-  toNorm Nothing  = ListN []         (ListT (reify (undefined :: a)))-  toNorm (Just x) = ListN [toNorm x] (ListT (reify (undefined :: a)))-  fromNorm (ListN []      (ListT _)) = Nothing-  fromNorm (ListN (x : _) (ListT _)) = Just (fromNorm x)-  fromNorm _ = $impossible+  reify _ = reify ([] :: [a]) +  toNorm Nothing  = toNorm ([] :: [a])+  toNorm (Just x) = toNorm [x]++  fromNorm ma = case (fromNorm ma) :: [a] of+                  []      -> Nothing+                  (x : _) -> Just x++instance (QA a,QA b) => QA (Either a b) where+  reify _ = reify (([],[]) :: ([a],[b]))++  toNorm (Left  x) = toNorm ([x],[] :: [b])+  toNorm (Right x) = toNorm ([] :: [a],[x])++  fromNorm e =  case (fromNorm e) :: ([a],[b]) of+                  ([],x : _) -> Right x+                  (x : _,[]) -> Left  x+                  _          -> $impossible+++tupleToEither :: (QA a,QA b) => Q ([a],[b]) -> Q (Either a b)+tupleToEither (Q x) = (Q x)++eitherToTuple :: (QA a,QA b) => Q (Either a b) -> Q ([a],[b])+eitherToTuple (Q x) = (Q x)+ class BasicType a where  instance BasicType () where@@ -437,7 +457,7 @@              TextN t _           -> Right $ SqlString $ T.unpack t              ListN _ _           -> convError "Cannot convert `Norm' to `SqlValue'" n              TupleN _ _ _        -> convError "Cannot convert `Norm' to `SqlValue'" n-                        -                        ++ instance IsString (Q Text) where   fromString s = Q (TextE (T.pack s) TextT)

@@ -16,6 +16,7 @@  import Data.List import Data.Maybe+import Data.Either import GHC.Exts  import Data.Text (Text)@@ -30,204 +31,232 @@ getConn = connectPostgreSQL "user = 'postgres' password = 'haskell98' host = 'localhost' dbname = 'ferry'"  qc:: Testable prop => prop -> IO ()-qc = quickCheckWith stdArgs{maxSuccess = 100, maxSize = 10}+qc = quickCheckWith stdArgs{maxSuccess = 100, maxSize = 5} +putStrPad :: String -> IO ()+putStrPad s = putStr (s ++ replicate (32 - length s) ' ' )+ main :: IO () main = do     putStrLn "Supprted Types"     putStrLn "--------------"-    putStr "():             "+    putStrPad "()"     qc prop_unit-    putStr "Bool:           "+    putStrPad "Bool"     qc prop_bool-    putStr "Char:           "+    putStrPad "Char"     qc prop_char-    putStr "Text:           "+    putStrPad "Text"     qc prop_text-    putStr "Integer:        "+    putStrPad "Integer"     qc prop_integer-    putStr "Double:         "+    putStrPad "Double"     qc prop_double-    putStr "[Integer]:      "+    putStrPad "[Integer]"     qc prop_list_integer_1-    putStr "[[Integer]]:    "+    putStrPad "[[Integer]]"     qc prop_list_integer_2-    putStr "[[[Integer]]]:  "+    putStrPad "[[[Integer]]]"     qc prop_list_integer_3-    putStr "Maybe Integer:  "+    putStrPad "Maybe Integer"     qc prop_maybe_integer--+    putStrPad "Either Integer Integer: "+    qc prop_either_integer+         putStrLn ""     putStrLn "Equality, Boolean Logic and Ordering"     putStrLn "------------------------------------"-    putStr "&&:             "+    putStrPad "&&"     qc prop_infix_and-    putStr "||:             "+    putStrPad "||"     qc prop_infix_or-    putStr "not:            "+    putStrPad "not"     qc prop_not-    putStr "eq:             "+    putStrPad "eq"     qc prop_eq-    putStr "neq:            "+    putStrPad "neq"     qc prop_neq-    putStr "cond:           "+    putStrPad "cond"     qc prop_cond-    putStr "lt:             "+    putStrPad "lt"     qc prop_lt-    putStr "lte:            "+    putStrPad "lte"     qc prop_lte-    putStr "gt:             "+    putStrPad "gt"     qc prop_gt-    putStr "gte:            "+    putStrPad "gte"     qc prop_gte-    putStr "min_integer:    "+    putStrPad "min_integer"     qc prop_min_integer-    putStr "min_double:     "+    putStrPad "min_double"     qc prop_min_double-    putStr "max_integer:    "+    putStrPad "max_integer"     qc prop_max_integer-    putStr "max_double:     "+    putStrPad "max_double"     qc prop_max_double          putStrLn ""     putStrLn "Tuples"     putStrLn "------"-    putStr "fst:            "+    putStrPad "fst"     qc prop_fst-    putStr "snd:            "+    putStrPad "snd"     qc prop_snd          putStrLn ""     putStrLn "Numerics:"     putStrLn "-----------"-    putStr "add_integer:    "+    putStrPad "add_integer"     qc prop_add_integer-    putStr "add_double:     "+    putStrPad "add_double"     qc prop_add_double-    putStr "mul_integer:    "+    putStrPad "mul_integer"     qc prop_mul_integer-    putStr "mul_double:     "+    putStrPad "mul_double"     qc prop_mul_double-    putStr "div_double:     "+    putStrPad "div_double"     qc prop_div_double-    putStr "integer_to_double: "+    putStrPad "integer_to_double: "     qc prop_integer_to_double    -    putStr "abs_integer:    "+    putStrPad "abs_integer"     qc prop_abs_integer-    putStr "abs_double:     "+    putStrPad "abs_double"     qc prop_abs_double-    putStr "signum_integer: "+    putStrPad "signum_integer: "     qc prop_signum_integer-    putStr "signum_double:  "+    putStrPad "signum_double"     qc prop_signum_double-    putStr "negate_integer: "+    putStrPad "negate_integer: "     qc prop_negate_integer-    putStr "negate_double:  "+    putStrPad "negate_double"     qc prop_negate_double-+         putStrLn ""     putStrLn "Maybe"     putStrLn "-----"-    putStr "maybe:          "+    putStrPad "maybe"     qc prop_maybe-    putStr "isJust:         "+    putStrPad "just"+    qc prop_just+    putStrPad "isJust"     qc prop_isJust-    putStr "isNothing:      "+    putStrPad "isNothing"     qc prop_isNothing-    putStr "fromJust:       "+    putStrPad "fromJust"     qc prop_fromJust-    putStr "fromMaybe:      "+    putStrPad "fromMaybe"     qc prop_fromMaybe-    putStr "listToMaybe:    "+    putStrPad "listToMaybe"     qc prop_listToMaybe-    putStr "maybeToList:    "+    putStrPad "maybeToList"     qc prop_maybeToList-    putStr "catMaybes:      "+    putStrPad "catMaybes"     qc prop_catMaybes-    putStr "mapMaybe:       "+    putStrPad "mapMaybe"     qc prop_mapMaybe-+         putStrLn ""+    putStrLn "Either"+    putStrLn "-----"+    putStrPad "left"+    qc prop_left+    putStrPad "right"+    qc prop_right+    putStrPad "isLeft"+    qc prop_isLeft+    putStrPad "isRight"+    qc prop_isRight+    putStrPad "either"+    qc prop_either+    putStrPad "lefts"+    qc prop_lefts+    putStrPad "rights"+    qc prop_rights+    putStrPad "partitionEithers"+    qc prop_partitionEithers+    +    putStrLn ""     putStrLn "Lists"     putStrLn "-----"-    putStr "head:           "+    putStrPad "head"     qc prop_head-    putStr "tail:           "+    putStrPad "tail"     qc prop_tail-    putStr "cons:           "+    putStrPad "cons"     qc prop_cons-    putStr "snoc:           "+    putStrPad "snoc"     qc prop_snoc-    putStr "take:           "+    putStrPad "take"     qc prop_take-    putStr "drop:           "+    putStrPad "drop"     qc prop_drop-    putStr "map:            "+    putStrPad "map"     qc prop_map-    putStr "filter:         "+    putStrPad "filter"     qc prop_filter-    putStr "the:            "+    putStrPad "the"     qc prop_the-    putStr "last:           "+    putStrPad "last"     qc prop_last-    putStr "init:           "+    putStrPad "init"     qc prop_init-    putStr "null:           "+    putStrPad "null"     qc prop_null-    putStr "length:         "+    putStrPad "length"     qc prop_length-    putStr "index:          "+    putStrPad "index"     qc prop_index-    putStr "reverse:        "+    putStrPad "reverse"     qc prop_reverse-    putStr "append:         "+    putStrPad "append"     qc prop_append-    putStr "groupWith:      "+    putStrPad "groupWith"     qc prop_groupWith-    putStr "sortWith:       "+    putStrPad "sortWith"     qc prop_sortWith-    putStr "and:            "+    putStrPad "and"     qc prop_and-    putStr "or:             "+    putStrPad "or"     qc prop_or-    putStr "any_zero:       "+    putStrPad "any_zero"     qc prop_any_zero-    putStr "all_zero:       "+    putStrPad "all_zero"     qc prop_all_zero-    putStr "sum_integer:    "+    putStrPad "sum_integer"     qc prop_sum_integer-    putStr "sum_double:     "+    putStrPad "sum_double"     qc prop_sum_double-    putStr "concat:         "+    putStrPad "concat"     qc prop_concat-    putStr "concatMap:      "+    putStrPad "concatMap"     qc prop_concatMap-    putStr "maximum:        "+    putStrPad "maximum"     qc prop_maximum-    putStr "minimum:        "+    putStrPad "minimum"     qc prop_minimum-    putStr "splitAt:        "+    putStrPad "splitAt"     qc prop_splitAt-    putStr "takeWhile:      "+    putStrPad "takeWhile"     qc prop_takeWhile-    putStr "dropWhile:      "+    putStrPad "dropWhile"     qc prop_dropWhile-    putStr "span:           "+    putStrPad "span"     qc prop_span-    putStr "break:          "+    putStrPad "break"     qc prop_break-    putStr "elem:           "+    putStrPad "elem"     qc prop_elem-    putStr "notElem:        "+    putStrPad "notElem"     qc prop_notElem-    putStr "zip:            "+    putStrPad "lookup"+    qc prop_lookup+    putStrPad "zip"     qc prop_zip-    putStr "zipWith:        "+    putStrPad "zipWith"     qc prop_zipWith-    putStr "unzip:          "+    putStrPad "unzip"     qc prop_unzip-    putStr "nub:            "+    putStrPad "nub"     qc prop_nub  makeProp :: (Eq b, QA a, QA b, Show a, Show b)@@ -297,6 +326,9 @@ prop_maybe_integer :: Maybe Integer -> Property prop_maybe_integer = makeProp id id +prop_either_integer :: Either Integer Integer -> Property+prop_either_integer = makeProp id id+ -- * Equality, Boolean Logic and Ordering  prop_infix_and :: (Bool,Bool) -> Property@@ -346,6 +378,9 @@ prop_maybe :: (Integer, Maybe Integer) -> Property prop_maybe =  makeProp (\a -> Q.maybe (Q.fst a) id (Q.snd a)) (\(i,mi) -> maybe i id mi) +prop_just :: Integer -> Property+prop_just = makeProp Q.just Just+ prop_isJust :: Maybe Integer -> Property prop_isJust = makeProp Q.isJust isJust @@ -370,6 +405,32 @@ prop_mapMaybe :: [Maybe Integer] -> Property prop_mapMaybe = makeProp (Q.mapMaybe id) (mapMaybe id) +-- * Either++prop_left :: Integer -> Property+prop_left = makeProp (Q.left :: Q Integer -> Q (Either Integer Integer)) Left++prop_right :: Integer -> Property+prop_right = makeProp (Q.right :: Q Integer -> Q (Either Integer Integer)) Right++prop_isLeft :: Either Integer Integer -> Property+prop_isLeft = makeProp Q.isLeft (\e -> case e of {Left _ -> True; Right _ -> False;})++prop_isRight :: Either Integer Integer -> Property+prop_isRight = makeProp Q.isRight (\e -> case e of {Left _ -> False; Right _ -> True;})++prop_either :: (Either Integer Integer) -> Property+prop_either =  makeProp (Q.either id id) (either id id)++prop_lefts :: [Either Integer Integer] -> Property+prop_lefts =  makeProp Q.lefts lefts++prop_rights :: [Either Integer Integer] -> Property+prop_rights =  makeProp Q.rights rights++prop_partitionEithers :: [Either Integer Integer] -> Property+prop_partitionEithers =  makeProp Q.partitionEithers partitionEithers+ -- * Lists  prop_cons :: (Integer, [Integer]) -> Property@@ -489,11 +550,15 @@  prop_elem :: (Integer, [Integer]) -> Property prop_elem = makeProp (uncurryQ $ Q.elem)-                     (uncurry   $   elem)+                     (uncurry  $   elem)  prop_notElem :: (Integer, [Integer]) -> Property prop_notElem = makeProp (uncurryQ $ Q.notElem)-                        (uncurry   $   notElem)+                        (uncurry  $   notElem)++prop_lookup :: (Integer, [(Integer,Integer)]) -> Property+prop_lookup = makeProp (uncurryQ $ Q.lookup)+                       (uncurry  $   lookup)  prop_zip :: ([Integer], [Integer]) -> Property prop_zip = makeProp (uncurryQ Q.zip) (uncurry zip)