hunk ./src/Database/Squiggle/Types.hs 572
-   sameT (SFField (False, _) x) (SFField (False, _) x') | x == x' = mkSameBaseUnsafe True
+   sameT (SFField (False, _) x :: SqlFields a) (SFField (False, _) x' :: SqlFields a') | x == x' = sameT (dummyVal :: SqlExpr a) (dummyVal :: SqlExpr a')
hunk ./src/Database/Squiggle/Types.hs 777
--- TODO annotate fields with some witness value to remove need for this
-mkSameBaseUnsafe :: Bool -> Maybe (EqTypes a a')
-mkSameBaseUnsafe False = Nothing
-mkSameBaseUnsafe True = Just (unsafeCoerce EqId)
-
hunk ./src/Database/Squiggle/Types.hs 816
-  SEField tn fn `sameT` SEField tn' fn' = mkSameBaseUnsafe $ tn Prelude.== tn' && fn Prelude.== fn'
+  (SEField tn fn :: SqlExpr' q a) `sameT` (SEField tn' fn' :: SqlExpr' q a')
+      | tn Prelude.== tn' && fn Prelude.== fn' = (dummyVal :: SqlExpr a) `sameT` (dummyVal :: SqlExpr a')
hunk ./src/Database/Squiggle/Types.hs 840
-  IntKnown as `sameT` IntKnown as' = foldr mkSameAnd (mkSameBaseUnsafe True) $ zipWith sameT as as'
+  (IntKnown as :: IntQuery a) `sameT` (IntKnown as' :: IntQuery a') = foldr mkSameAnd (sameT (dummyVal :: SqlExpr a) (dummyVal :: SqlExpr a')) $ zipWith sameT as as'
hunk ./src/Database/Squiggle/Types.hs 671
+  SLInt a * SLInt b = SLInt (a * b)
+  SLDouble a * SLDouble b = SLDouble (a * b)
+  abs (SLInt a) = SLInt (abs a)
+  abs (SLDouble a) = SLDouble (abs a)
+  signum (SLInt a) = SLInt (signum a)
+  signum (SLDouble a) = SLDouble (signum a)
hunk ./src/Database/Squiggle/MkInstances.hs 14
+     let paramName = case param of
+                      PlainTV n -> n
+                      KindedTV n _ -> n
+
hunk ./src/Database/Squiggle/MkInstances.hs 46
-                       [] | (cls, arg) <- [(AppT (ConT ''HasSql) (VarT param), VarT param),
+                       [] | (cls, arg) <- [(AppT (ConT ''HasSql) (VarT paramName), VarT paramName),
hunk ./src/Database/Squiggle/MkInstances.hs 53
-            [InstanceD [AppT (ConT ''SqlConstr) (VarT param)]
-                       (AppT (ConT ''Show) (AppT (ConT tname) (VarT param)))
+            [InstanceD [ClassP ''SqlConstr [VarT paramName]]
+                       (AppT (ConT ''Show) (AppT (ConT tname) (VarT paramName)))
hunk ./src/Database/Squiggle/MySQL.hs 2
-  OverloadedStrings #-}
+  OverloadedStrings, GADTs #-}
hunk ./src/Database/Squiggle/Types.hs 329
-fm_boolsA = Accessor fm_bools (\x fm -> fm { fm_bools = x })
-fm_mboolsA = Accessor fm_mbools (\x fm -> fm { fm_mbools = x })
-fm_intsA = Accessor fm_ints (\x fm -> fm { fm_ints = x })
-fm_mintsA = Accessor fm_mints (\x fm -> fm { fm_mints = x })
-fm_charsA = Accessor fm_chars (\x fm -> fm { fm_chars = x })
-fm_mcharsA = Accessor fm_mchars (\x fm -> fm { fm_mchars = x })
-fm_stringsA = Accessor fm_strings (\x fm -> fm { fm_strings = x })
-fm_mstringsA = Accessor fm_mstrings (\x fm -> fm { fm_mstrings = x })
-fm_datesA = Accessor fm_dates (\x fm -> fm { fm_dates = x })
-fm_mdatesA = Accessor fm_mdates (\x fm -> fm { fm_mdates = x })
-fm_doublesA = Accessor fm_doubles (\x fm -> fm { fm_doubles = x })
-fm_mdoublesA = Accessor fm_mdoubles (\x fm -> fm { fm_mdoubles = x })
+fm_boolsA = accessor fm_bools (\x fm -> fm { fm_bools = x })
+fm_mboolsA = accessor fm_mbools (\x fm -> fm { fm_mbools = x })
+fm_intsA = accessor fm_ints (\x fm -> fm { fm_ints = x })
+fm_mintsA = accessor fm_mints (\x fm -> fm { fm_mints = x })
+fm_charsA = accessor fm_chars (\x fm -> fm { fm_chars = x })
+fm_mcharsA = accessor fm_mchars (\x fm -> fm { fm_mchars = x })
+fm_stringsA = accessor fm_strings (\x fm -> fm { fm_strings = x })
+fm_mstringsA = accessor fm_mstrings (\x fm -> fm { fm_mstrings = x })
+fm_datesA = accessor fm_dates (\x fm -> fm { fm_dates = x })
+fm_mdatesA = accessor fm_mdates (\x fm -> fm { fm_mdates = x })
+fm_doublesA = accessor fm_doubles (\x fm -> fm { fm_doubles = x })
+fm_mdoublesA = accessor fm_mdoubles (\x fm -> fm { fm_mdoubles = x })
hunk ./src/Database/Squiggle/Types.hs 671
-  SLInt a * SLInt b = SLInt (a * b)
-  SLDouble a * SLDouble b = SLDouble (a * b)
-  abs (SLInt a) = SLInt (abs a)
-  abs (SLDouble a) = SLDouble (abs a)
-  signum (SLInt a) = SLInt (signum a)
-  signum (SLDouble a) = SLDouble (signum a)
hunk ./src/Database/Squiggle/Types.hs 1108
-instance Num (SqlLit Int) where
-   fromInteger = SLInt . fromInteger
+instance (SqlPrimType a, Num a) => Num (SqlLit a) where
hunk ./src/Database/Squiggle/Types.hs 1110
+   SLDouble a + SLDouble b = SLDouble (a + b)
+
hunk ./src/Database/Squiggle/Types.hs 1113
+   SLDouble a - SLDouble b = SLDouble (a - b)
+
hunk ./src/Database/Squiggle/Types.hs 1116
+   SLDouble a * SLDouble b = SLDouble (a * b)
+
hunk ./src/Database/Squiggle/Types.hs 1119
+   negate (SLDouble a) = SLDouble (negate a)
+
+   fromInteger = DM.fromJust . toLit . toSqlE . fromInteger
+
hunk ./src/Database/Squiggle/Types.hs 1124
+   abs (SLDouble a) = SLDouble (abs a)
+
hunk ./src/Database/Squiggle/Types.hs 1127
+   signum (SLDouble a) = SLDouble (signum a)
hunk ./src/Database/Squiggle/Types.hs 1138
-instance Num (SqlLit Double) where
-   fromInteger = SLDouble . fromInteger
-   SLDouble a + SLDouble b = SLDouble (a + b)
-   SLDouble a - SLDouble b = SLDouble (a - b)
-   SLDouble a * SLDouble b = SLDouble (a * b)
-   negate (SLDouble a) = SLDouble (negate a)
-   abs (SLDouble a) = SLDouble (abs a)
-   signum (SLDouble a) = SLDouble (signum a)
-
hunk ./src/Test.hs 9
-table_foo = table "foo" (field "a", field "b")
+table_foo = table (Nothing, "foo") (field "a", field "b")
hunk ./src/Test.hs 12
-table_bar = table "bar" (field "d", field "e", field "f")
+table_bar = table (Nothing, "bar") (field "d", field "e", field "f")
hunk ./src/Database/Squiggle/Types.hs 66
+infix 1 ?
+
hunk ./src/Database/Squiggle/Types.hs 635
+  SPCeiling :: SqlPrim (Double -> Int)
+  SPFloor :: SqlPrim (Double -> Int)
hunk ./src/Database/Squiggle/Types.hs 2991
-renderSqlExpr' n (SEApp (SEPrim SPDoubleToInt) a) as = renderSqlExpr' n a (fmap castSqlField as)
+renderSqlExpr' n (SEApp (SEPrim SPDoubleToInt) a) as = text "cast" <> parens (renderSqlExpr 0 a <+> text "AS SIGNED") <+> renderAs as
+renderSqlExpr' n (SEApp (SEPrim SPFloor) e) as = text "floor" <> parens (renderSqlExpr 0 e) <+> renderAs as
+renderSqlExpr' n (SEApp (SEPrim SPCeiling) e) as = text "ceiling" <> parens (renderSqlExpr 0 e) <+> renderAs as
hunk ./src/Database/Squiggle/Types.hs 672
-instance (SqlPrimType a, Num a) => Num (SqlLit a) where
-  SLInt a + SLInt b = SLInt (a + b)
-  SLDouble a + SLDouble b = SLDouble (a + b)
-  fromInteger = DM.fromJust . toLit . toSqlE . fromInteger
addfile ./squiggle.cabal
hunk ./squiggle.cabal 1
+name:		 squiggle
+version:	 0.1
+license:	 GPL
+author:		 Ganesh Sittampalam
+category:	 None
+description:	 Help keep track of cash
+exposed-modules:
+other-modules:
+build-depends:	 base, data-accessor, hsql
+extensions:
+build-type: Simple
+buildable: False
hunk ./squiggle.cabal 9
-build-depends:	 base, data-accessor, hsql
+build-depends:	 base, data-accessor, hsql, HDBC, time, Safe
hunk ./src/Database/Squiggle/MySQL.hs 7
-import Database.HSQL.MySQL
+import qualified Database.HSQL.MySQL as HSQL
+import qualified Database.HDBC as HDBC
+import qualified Database.HDBC.MySQL as HDBC
hunk ./src/Database/Squiggle/MySQL.hs 14
+class Connection c where
+   go :: HasProdEnc a => c -> (Doc, SqlFields (ProdEnc a)) -> IO [a]
hunk ./src/Database/Squiggle/MySQL.hs 17
-run :: Connection -> Query a -> IO [a]
-run db = handleNested $ \q -> flip catchSql (fail . show) $
-           do let (sql, fields) = renderPrimQuery $ compileQ q
-              stmt <- query db (render sql)
-              collectRows (\stmt -> liftM decode $ retr stmt fields) stmt
+instance Connection HDBC.Connection where
+   go db (sql, fields) = flip HDBC.catchSql (fail . show) $ do
+            stmt <- HDBC.prepare db (render sql)
+            HDBC.execute stmt []
+            liftM (map (decode . readFields fields)) (HDBC.fetchAllRows stmt)
+    where
+      readFields :: SqlFields b -> [HDBC.SqlValue] -> b
+      readFields fields values = case readFields' fields values of
+	                             (v, []) -> v
+                                     _ -> error "Surplus field values left over after read from query results"
hunk ./src/Database/Squiggle/MySQL.hs 28
-unoptRun :: Connection -> Query a -> IO [a]
-unoptRun db = handleNested $ \q -> flip catchSql (fail . show) $
-           do let (sql, fields) = renderPrimQuery $ unoptCompileQ q
-              stmt <- query db (render sql)
-              collectRows (\stmt -> liftM decode $ retr stmt fields) stmt
+      readFields' :: SqlFields b -> [HDBC.SqlValue] -> (b, [HDBC.SqlValue])
+      readFields' (SFField _ _) (v:vs) = (HDBC.fromSql v, vs)
+      readFields' (SFField _ x) [] = error $ "Ran out of field values while reading field " ++ unFieldName x
+      readFields' SFNil vs = (Nil, vs)
+      readFields' (SFProd x y) vs = let (a, vs') = readFields' x vs
+                                        (b, vs'') = readFields' y vs'
+                                    in (Prod a b, vs'')
hunk ./src/Database/Squiggle/MySQL.hs 37
+instance Connection HSQL.Connection where
+   go db (sql, fields) = flip HSQL.catchSql (fail . show) $ do
+            stmt <- HSQL.query db (render sql)
+            HSQL.collectRows (\stmt -> liftM decode $ retr stmt fields) stmt
+    where
+      retr :: HSQL.Statement -> SqlFields b -> IO b
+      retr stmt (SFField _ x) = HSQL.getFieldValue stmt (unFieldName x)
+      retr stmt SFNil = return Nil
+      retr stmt (SFProd x y) = liftM2 Prod (retr stmt x) (retr stmt y)
hunk ./src/Database/Squiggle/MySQL.hs 47
-retr :: Statement -> SqlFields b -> IO b
-retr stmt (SFField _ x) = getFieldValue stmt (unFieldName x)
-retr stmt SFNil = return Nil
-retr stmt (SFProd x y) = liftM2 Prod (retr stmt x) (retr stmt y)
+
+run :: Connection c => c -> Query a -> IO [a]
+run db = handleNested $ \q ->
+              go db $ renderPrimQuery $ compileQ q
+
+
+unoptRun :: Connection c => c -> Query a -> IO [a]
+unoptRun db = handleNested $ \q ->
+              go db $ renderPrimQuery $ unoptCompileQ q
hunk ./src/Database/Squiggle/MySQL.hs 107
-explain :: Connection -> Query a -> IO [[Explanation Id]]
-explain db = collectNestedM $ \q -> flip catchSql (fail . show) $ 
+explain :: Connection c => c -> Query a -> IO [[Explanation Id]]
+explain db = collectNestedM $ \q ->
hunk ./src/Database/Squiggle/MySQL.hs 111
-                  stmt <- query db (render sql)
-                  collectRows (\stmt -> liftM decode $ retr stmt fields) stmt
+                  go db (sql, fields)
+
+
+
hunk ./src/Database/Squiggle/Types.hs 11
+import Data.Time.Calendar
hunk ./src/Database/Squiggle/Types.hs 30
+import Data.Convertible
+import qualified Database.HDBC as HDBC
+
hunk ./src/Database/Squiggle/Types.hs 1165
-class (Show a, Eq a, SqlEq a, SqlBind a, SqlBE a) => SqlPrimType a where
+class (Show a, Eq a, SqlEq a, SqlBind a, SqlBE a, Convertible HDBC.SqlValue a) => SqlPrimType a where
hunk ./src/Database/Squiggle/Types.hs 1182
+instance Convertible HDBC.SqlValue Date where
+  safeConvert value = fmap mkDate (safeConvert value)
+    where
+      mkDate day = let (y, m, d) = toGregorian (day :: Day)
+                   in Date (fromInteger y, m, d)
+
hunk ./squiggle.cabal 9
-build-depends:	 base, data-accessor, hsql, HDBC, time, Safe
+build-depends:	 base, data-accessor, hsql, hsql-mysql, HDBC, time, Safe, HDBC-mysql
hunk ./src/Database/Squiggle/Types.hs 2121
+data Command where
+  Insert :: (HasSqlExpr a sea, HasSqlFields a sfa, UnSqlExpr (ProdEnc sea) ~ UnSqlFields (ProdEnc sfa),
+            HasProdEnc a, ProdEnc a ~ UnSqlExpr (ProdEnc sea))
+         => sea -> (Maybe DBName, TableName) -> sfa -> Command
+
hunk ./src/Database/Squiggle/Types.hs 2244
+translateC :: Command -> PrimCommand
+translateC (Insert a tn fields) = PrimInsert (translateSqlExprIQPQ $ encodeSqlExpr a) tn (encodeSqlFields fields)
+
hunk ./src/Database/Squiggle/Types.hs 2891
+data PrimCommand where
+   PrimInsert :: SqlBE a => SqlExprP a -> (Maybe DBName, TableName) -> SqlFields a -> PrimCommand
+
+
hunk ./src/Database/Squiggle/Types.hs 2933
+insert = Insert
+
hunk ./src/Database/Squiggle/Types.hs 3092
+renderPrimCommand :: PrimCommand -> Doc
+renderPrimCommand (PrimInsert v (dn, tn) fields) = text "INSERT INTO" <+> text (maybe id (\ a b -> a ++ "." ++ b) dn tn) <+> text "SET" <+>
+                                                   renderSqlAssign v fields
+
+renderSqlAssign :: SqlExprP a -> SqlFields a -> Doc
+renderSqlAssign SENil SFNil = empty
+renderSqlAssign e (SFProd f1 f2) | isNil f1 = renderSqlAssign (sel2 e) f2
+                                 | isNil f2 = renderSqlAssign (sel1 e) f1
+   where isNil :: SqlFields a -> Bool
+         isNil SFNil = True
+         isNil (SFProd a b) = isNil a && isNil b
+         isNil _ = False
+renderSqlAssign (SEProd e1 e2) (SFProd f1 f2) = renderSqlAssign e1 f1 <> comma <> renderSqlAssign e2 f2
+renderSqlAssign e (SFField _ (FieldName fn)) = text fn <> text "=" <> renderSqlExpr 0 e
+
hunk ./src/Database/Squiggle/Types.hs 3322
+renderC = renderPrimCommand . translateC
+
hunk ./src/Database/Squiggle/MySQL.hs 47
+-- there seems to be a problem with MySQL 5.1 exposed by HDBC-mysql, to do
+-- with the way the types of fields
+-- are reported; if a query produces a NULL in the first row it seems to then
+-- affect the handling of future rows.
+--
+-- This works:
+--   SELECT 3.0 AS afield UNION ALL SELECT NULL AS afield
+-- This breaks:
+--   SELECT NULL AS afield UNION ALL SELECT 3.0 AS afield
+-- This works:
+--   SELECT afield FROM (SELECT NULL AS afield UNION ALL SELECT 3.0 AS afield) AS x
+--
+-- As a workaround we try to engineer the latter wrapping, relying
+-- on the optimiser to be sufficiently dumb not to notice!
+wrap q = project fst (q `times` unit (1 :: SqlExpr Int))
+
hunk ./src/Database/Squiggle/MySQL.hs 66
-              go db $ renderPrimQuery $ compileQ q
+              go db $ renderPrimQuery $ compileQ $ wrap q
hunk ./src/Database/Squiggle/MySQL.hs 71
-              go db $ renderPrimQuery $ unoptCompileQ q
+              go db $ renderPrimQuery $ unoptCompileQ $ wrap q
hunk ./src/Database/Squiggle/Types.hs 2916
+times = join (\_ _ -> true)
+
hunk ./src/Database/Squiggle/Types.hs 2464
+optSE' facts (SEApp (SEApp (SEPrim SPEq) e1) e2)
+  | SEPrim (SPLit (SLInt n1)) <- e1', SEPrim (SPLit (SLInt n2)) <- e2' = SEPrim (SPLit (SLBool (n1 == n2)))
+ where e1' = optSE' facts e1
+       e2' = optSE' facts e2
+
+optSE' facts (SEApp (SEApp (SEPrim SPNe) e1) e2)
+  | SEPrim (SPLit (SLInt n1)) <- e1', SEPrim (SPLit (SLInt n2)) <- e2' = SEPrim (SPLit (SLBool (n1 /= n2)))
+ where e1' = optSE' facts e1
+       e2' = optSE' facts e2
+
hunk ./src/Database/Squiggle/Types.hs 2479
+optSE' facts (SEApp (SEApp (SEPrim SPLe) e1) e2)
+  | SEPrim (SPLit (SLInt n1)) <- e1', SEPrim (SPLit (SLInt n2)) <- e2' = SEPrim (SPLit (SLBool (n1 <= n2)))
+ where e1' = optSE' facts e1
+       e2' = optSE' facts e2
+
hunk ./src/Database/Squiggle/Types.hs 2489
+optSE' facts (SEApp (SEApp (SEPrim SPGe) e1) e2)
+  | SEPrim (SPLit (SLInt n1)) <- e1', SEPrim (SPLit (SLInt n2)) <- e2' = SEPrim (SPLit (SLBool (n1 >= n2)))
+ where e1' = optSE' facts e1
+       e2' = optSE' facts e2
+
hunk ./src/Database/Squiggle/MySQL.hs 15
-   go :: HasProdEnc a => c -> (Doc, SqlFields (ProdEnc a)) -> IO [a]
+   goC :: c -> Doc -> IO ()
+   goQ :: HasProdEnc a => c -> (Doc, SqlFields (ProdEnc a)) -> IO [a]
hunk ./src/Database/Squiggle/MySQL.hs 19
-   go db (sql, fields) = flip HDBC.catchSql (fail . show) $ do
+   goC db sql = flip HDBC.catchSql (fail . show) $ do
+            stmt <- HDBC.prepare db (render sql)
+            HDBC.execute stmt []
+            return ()
+
+   goQ db (sql, fields) = flip HDBC.catchSql (fail . show) $ do
hunk ./src/Database/Squiggle/MySQL.hs 44
-   go db (sql, fields) = flip HSQL.catchSql (fail . show) $ do
+   goC db sql = flip HSQL.catchSql (fail . show) $ do
+            HSQL.query db (render sql)
+            return ()
+
+   goQ db (sql, fields) = flip HSQL.catchSql (fail . show) $ do
hunk ./src/Database/Squiggle/MySQL.hs 74
-run :: Connection c => c -> Query a -> IO [a]
-run db = handleNested $ \q ->
-              go db $ renderPrimQuery $ compileQ $ wrap q
+query :: Connection c => c -> Query a -> IO [a]
+query db = handleNested $ \q ->
+              goQ db $ renderPrimQuery $ compileQ $ wrap q
+
+
+unoptQuery :: Connection c => c -> Query a -> IO [a]
+unoptQuery db = handleNested $ \q ->
+                  goQ db $ renderPrimQuery $ unoptCompileQ $ wrap q
hunk ./src/Database/Squiggle/MySQL.hs 84
-unoptRun :: Connection c => c -> Query a -> IO [a]
-unoptRun db = handleNested $ \q ->
-              go db $ renderPrimQuery $ unoptCompileQ $ wrap q
+run :: Connection c => c -> Command -> IO ()
+run db c = goC db $ renderPrimCommand $ compileC c
+
+
+unoptRun :: Connection c => c -> Command -> IO ()
+unoptRun db c = goC db $ renderPrimCommand $ unoptCompileC c
+
hunk ./src/Database/Squiggle/MySQL.hs 146
-                  go db (sql, fields)
-
-
+                  goQ db (sql, fields)
hunk ./src/Database/Squiggle/Types.hs 2078
+data DBTable a where
+  DBTable :: (HasSqlExpr a sea, HasSqlFields a sfa, UnSqlExpr (ProdEnc sea) ~ UnSqlFields (ProdEnc sfa),
+              HasProdEnc a, ProdEnc a ~ UnSqlExpr (ProdEnc sea))
+          => (Maybe DBName, TableName) -> sfa -> DBTable a
+
hunk ./src/Database/Squiggle/Types.hs 2087
-  Table :: (HasSqlExpr a sea, HasSqlFields a sfa, UnSqlExpr (ProdEnc sea) ~ UnSqlFields (ProdEnc sfa),
-            HasProdEnc a, ProdEnc a ~ UnSqlExpr (ProdEnc sea))
-        => (Maybe DBName, TableName) -> sfa -> Query a
+  Table :: DBTable a -> Query a
hunk ./src/Database/Squiggle/Types.hs 2125
-  Insert :: (HasSqlExpr a sea, HasSqlFields a sfa, UnSqlExpr (ProdEnc sea) ~ UnSqlFields (ProdEnc sfa),
-            HasProdEnc a, ProdEnc a ~ UnSqlExpr (ProdEnc sea))
-         => sea -> (Maybe DBName, TableName) -> sfa -> Command
+  Insert :: (HasSqlExpr a sea, HasProdEnc a, ProdEnc a ~ UnSqlExpr (ProdEnc sea))
+         => sea -> DBTable a -> Command
hunk ./src/Database/Squiggle/Types.hs 2138
-handleNested f q@(Table _ _) = f q
+handleNested f q@(Table (DBTable _ _)) = f q
hunk ./src/Database/Squiggle/Types.hs 2215
-translateQ (Table tn (fields :: sfa))
+translateQ (Table (DBTable tn (fields :: sfa)))
hunk ./src/Database/Squiggle/Types.hs 2247
-translateC (Insert a tn fields) = PrimInsert (translateSqlExprIQPQ $ encodeSqlExpr a) tn (encodeSqlFields fields)
+translateC (Insert a (DBTable tn fields)) = PrimInsert (translateSqlExprIQPQ $ encodeSqlExpr a) tn (encodeSqlFields fields)
hunk ./src/Database/Squiggle/Types.hs 2922
+dbtable = DBTable
hunk ./src/Database/Squiggle/Types.hs 3347
-renderC = renderPrimCommand . translateC
+compileC = translateC
+unoptCompileC = translateC
+
+renderC = renderPrimCommand . compileC
+unoptRenderC = renderPrimCommand . unoptCompileC
hunk ./src/Database/Squiggle/MySQL.hs 148
+lastInsertID :: Connection c => c -> IO Int
+lastInsertID db = do let sql = text "SELECT last_insert_id() as id"
+                         fields :: SqlFields Int
+                         fields = "id"
+                     [res] <- goQ db (sql, fields)
+                     return res
hunk ./src/Database/Squiggle/Types.hs 23
+import Data.Time.Clock
hunk ./src/Database/Squiggle/Types.hs 334
+                   , fm_utctimes  :: PSMap a UTCTime
+                   , fm_mutctimes  :: PSMap a (Maybe UTCTime)
hunk ./src/Database/Squiggle/Types.hs 350
+fm_utctimesA = accessor fm_utctimes (\x fm -> fm { fm_utctimes = x })
+fm_mutctimesA = accessor fm_mutctimes (\x fm -> fm { fm_mutctimes = x })
hunk ./src/Database/Squiggle/Types.hs 408
+                    , fm_utctimes  = psm_union (fm_utctimes x) (fm_utctimes y)
+                    , fm_mutctimes  = psm_union (fm_mutctimes x) (fm_mutctimes y)
hunk ./src/Database/Squiggle/Types.hs 425
+                , fm_utctimes = psm_empty
+                , fm_mutctimes = psm_empty
hunk ./src/Database/Squiggle/Types.hs 442
+                      , fm_utctimes = psm_map (. f) (fm_utctimes x)
+                      , fm_mutctimes = psm_map (. f) (fm_mutctimes x)
hunk ./src/Database/Squiggle/Types.hs 571
+instance FromFields UTCTime where
+  fromFields'' = fromFieldsPrim''
+  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_utctimes fm) v
+  reproject' fm (SFField _ fn) = psm_lookup fn (fm_utctimes fm)
+  buildFMap' (SFField _ fn) func fm = fm { fm_utctimes = psm_insert fn func (fm_utctimes fm) }
+
+instance FromFields (Maybe UTCTime) where
+  fromFields'' = fromFieldsPrim''
+  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mutctimes fm) v
+  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mutctimes fm)
+  buildFMap' (SFField _ fn) func fm = fm { fm_mutctimes = psm_insert fn func (fm_mutctimes fm) }
+
hunk ./src/Database/Squiggle/Types.hs 683
+  SLUTCTime :: UTCTime -> SqlLit UTCTime
hunk ./src/Database/Squiggle/Types.hs 986
+instance SqlEq UTCTime where
+  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
+
+instance SqlEq (Maybe UTCTime) where
+  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
+
hunk ./src/Database/Squiggle/Types.hs 1044
+instance SqlOrd UTCTime where
+  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
+  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
+  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
+  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+
hunk ./src/Database/Squiggle/Types.hs 1119
+instance HasSqlCmp (SqlExpr UTCTime) where
+  type SqlCmp (SqlExpr UTCTime) = SqlExpr UTCTime
+  comparisonFields = id
+
hunk ./src/Database/Squiggle/Types.hs 1222
+instance SqlBind UTCTime where
+  fromSqlValue typ field = error "TODO: HSQL binding for UTCTime"
+
hunk ./src/Database/Squiggle/Types.hs 1269
+instance SqlPrimType UTCTime where
+  sqlPrimTypeNullableDict _ = SqlPrimTypeDict
+  showPrimSql = show . show
+  toSqlE = SEPrim . SPLit . SLUTCTime
+
hunk ./src/Database/Squiggle/Types.hs 1289
+type instance Apply Maybe UTCTime = Maybe UTCTime
hunk ./src/Database/Squiggle/Types.hs 1586
+instance HasProdEnc UTCTime where
+   type ProdEnc UTCTime = UTCTime
+   encode = id
+   decode = id
+
+instance HasProdEnc (Id UTCTime) where
+   type ProdEnc (Id UTCTime) = Id UTCTime
+   encode = id
+   decode = id
+
+instance HasProdEnc (Maybe UTCTime) where
+   type ProdEnc (Maybe UTCTime) = Maybe UTCTime
+   encode = id
+   decode = id
+
+instance HasProdEnc (SqlExpr UTCTime) where
+   type ProdEnc (SqlExpr UTCTime) = SqlExpr UTCTime
+   encode = id
+   decode = id
+
+instance HasProdEnc (SqlExpr (Maybe UTCTime)) where
+   type ProdEnc (SqlExpr (Maybe UTCTime)) = SqlExpr (Maybe UTCTime)
+   encode = id
+   decode = id
+
+instance HasProdEnc (Comp SqlExpr Maybe UTCTime) where
+   type ProdEnc (Comp SqlExpr Maybe UTCTime) = SqlExpr (Maybe UTCTime)
+   encode = unComp
+   decode = Comp
+
+instance HasProdEnc (SqlFields UTCTime) where
+   type ProdEnc (SqlFields UTCTime) = SqlFields UTCTime
+   encode = id
+   decode = id
+
+instance HasProdEnc (SqlFields (Maybe UTCTime)) where
+   type ProdEnc (SqlFields (Maybe UTCTime)) = SqlFields (Maybe UTCTime)
+   encode = id
+   decode = id
+
+instance HasProdEnc (Comp SqlFields Maybe UTCTime) where
+   type ProdEnc (Comp SqlFields Maybe UTCTime) = SqlFields (Maybe UTCTime)
+   encode = unComp
+   decode = Comp
+
hunk ./src/Database/Squiggle/Types.hs 1640
+       HasProdEncS (Apply s UTCTime),
hunk ./src/Database/Squiggle/Types.hs 1646
-       HasProdEncS (Apply s (Maybe Double))
+       HasProdEncS (Apply s (Maybe Double)),
+       HasProdEncS (Apply s (Maybe UTCTime))
hunk ./src/Database/Squiggle/Types.hs 1755
+instance IsSqlExpr (SqlExpr UTCTime) where
+   type UnSqlExpr (SqlExpr UTCTime) = UTCTime
+   toSqlExpr = id
+   fromSqlExpr = id
+
hunk ./src/Database/Squiggle/Types.hs 1781
+instance IsSqlFields (SqlFields UTCTime) where
+   type UnSqlFields (SqlFields UTCTime) = UTCTime
+   toSqlFields = id
+   fromSqlFields = id
+
hunk ./src/Database/Squiggle/Types.hs 1891
+instance SqlConv UTCTime where
+   fieldsToExpr (SFField mtn x) = SEField mtn x
+   applyThe = SEApp (SEPrim SPThe)
+
+instance SqlConv (Maybe UTCTime) where
+   fieldsToExpr (SFField mtn x) = SEField mtn x
+   applyThe = SEApp (SEPrim SPThe)
+
hunk ./src/Database/Squiggle/Types.hs 1956
+instance SqlBE UTCTime where
+  sqlBENullableDict _ = SqlBEDict
+  dummyVal = SEPrim (SPLit (SLUTCTime (UTCTime (fromGregorian 1970 1 1) (secondsToDiffTime 0))))
+
hunk ./src/Database/Squiggle/Types.hs 1984
+instance SqlBE (Maybe UTCTime) where
+  sqlBENullableDict _ = SqlBEDict
+  dummyVal = SEPrim SPNull
+
hunk ./src/Database/Squiggle/Types.hs 1997
+type instance Nullable UTCTime = Maybe UTCTime
hunk ./src/Database/Squiggle/Types.hs 2036
+instance HasSql s UTCTime (s UTCTime)
+instance HasSql s (Maybe UTCTime) (s (Maybe UTCTime))
hunk ./src/Database/Squiggle/Types.hs 2057
+instance HasSqlFields UTCTime (SqlFields UTCTime)
+instance HasSqlFields (Maybe UTCTime) (SqlFields (Maybe UTCTime))
hunk ./src/Database/Squiggle/Types.hs 2080
+instance HasSqlExpr UTCTime (SqlExpr UTCTime)
+instance HasSqlExpr (Maybe UTCTime) (SqlExpr (Maybe UTCTime))
hunk ./src/Database/Squiggle/Types.hs 2104
+instance HasSqlAggr UTCTime (SqlAggr UTCTime)
+instance HasSqlAggr (Maybe UTCTime) (SqlAggr (Maybe UTCTime))
hunk ./src/Database/Squiggle/Types.hs 2138
+instance HasSqlLit UTCTime (SqlLit UTCTime) where
+   toSqlLit = SLUTCTime
+   fromSqlLit (SLUTCTime a) = a
+
hunk ./src/Database/Squiggle/Types.hs 3146
+renderSqlExpr' n (SEPrim (SPLit (SLUTCTime l))) as = text (showPrimSql l) <+> renderAs as
hunk ./src/Database/Squiggle/Types.hs 11
+import qualified Data.Accessor.Basic as Accessor
hunk ./src/Database/Squiggle/Types.hs 487
+reprojectHelper field fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ field fm) v
+reproject'Helper field fm (SFField _ fn) = psm_lookup fn (field fm)
+
+buildFMap'Helper :: Accessor (FMap b) (PSMap b a) -> SqlFields a -> (forall f . ProdSel f => f b -> f a) -> FMap b -> FMap b
+buildFMap'Helper fieldA (SFField _ fn) func fm = Accessor.modify fieldA (psm_insert fn func) fm
+
hunk ./src/Database/Squiggle/Types.hs 495
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_bools fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_bools fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_bools = psm_insert fn func (fm_bools fm) }
+  reproject = reprojectHelper fm_bools
+  reproject' = reproject'Helper fm_bools
+  buildFMap' = buildFMap'Helper fm_boolsA
hunk ./src/Database/Squiggle/Types.hs 508
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mbools fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mbools fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mbools = psm_insert fn func (fm_mbools fm) }
+  reproject = reprojectHelper fm_mbools
+  reproject' = reproject'Helper fm_mbools
+  buildFMap' = buildFMap'Helper fm_mboolsA
hunk ./src/Database/Squiggle/Types.hs 520
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_ints fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_ints fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_ints = psm_insert fn func (fm_ints fm) }
+  reproject = reprojectHelper fm_ints
+  reproject' = reproject'Helper fm_ints
+  buildFMap' = buildFMap'Helper fm_intsA
hunk ./src/Database/Squiggle/Types.hs 526
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mints fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mints fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mints = psm_insert fn func (fm_mints fm) }
+  reproject = reprojectHelper fm_mints
+  reproject' = reproject'Helper fm_mints
+  buildFMap' = buildFMap'Helper fm_mintsA
hunk ./src/Database/Squiggle/Types.hs 532
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_strings fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_strings fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_strings = psm_insert fn func (fm_strings fm) }
+  reproject = reprojectHelper fm_strings
+  reproject' = reproject'Helper fm_strings
+  buildFMap' = buildFMap'Helper fm_stringsA
hunk ./src/Database/Squiggle/Types.hs 538
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mstrings fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mstrings fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mstrings = psm_insert fn func (fm_mstrings fm) }
+  reproject = reprojectHelper fm_mstrings
+  reproject' = reproject'Helper fm_mstrings
+  buildFMap' = buildFMap'Helper fm_mstringsA
hunk ./src/Database/Squiggle/Types.hs 544
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_chars fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_chars fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_chars = psm_insert fn func (fm_chars fm) }
+  reproject = reprojectHelper fm_chars
+  reproject' = reproject'Helper fm_chars
+  buildFMap' = buildFMap'Helper fm_charsA
hunk ./src/Database/Squiggle/Types.hs 550
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mchars fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mchars fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mchars = psm_insert fn func (fm_mchars fm) }
+  reproject = reprojectHelper fm_mchars
+  reproject' = reproject'Helper fm_mchars
+  buildFMap' = buildFMap'Helper fm_mcharsA
hunk ./src/Database/Squiggle/Types.hs 556
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_dates fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_dates fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_dates = psm_insert fn func (fm_dates fm) }
+  reproject = reprojectHelper fm_dates
+  reproject' = reproject'Helper fm_dates
+  buildFMap' = buildFMap'Helper fm_datesA
hunk ./src/Database/Squiggle/Types.hs 562
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mdates fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mdates fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mdates = psm_insert fn func (fm_mdates fm) }
+  reproject = reprojectHelper fm_mdates
+  reproject' = reproject'Helper fm_mdates
+  buildFMap' = buildFMap'Helper fm_mdatesA
hunk ./src/Database/Squiggle/Types.hs 568
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_doubles fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_doubles fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_doubles = psm_insert fn func (fm_doubles fm) }
+  reproject = reprojectHelper fm_doubles
+  reproject' = reproject'Helper fm_doubles
+  buildFMap' = buildFMap'Helper fm_doublesA
hunk ./src/Database/Squiggle/Types.hs 574
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mdoubles fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mdoubles fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mdoubles = psm_insert fn func (fm_mdoubles fm) }
+  reproject = reprojectHelper fm_mdoubles
+  reproject' = reproject'Helper fm_mdoubles
+  buildFMap' = buildFMap'Helper fm_mdoublesA
hunk ./src/Database/Squiggle/Types.hs 580
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_utctimes fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_utctimes fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_utctimes = psm_insert fn func (fm_utctimes fm) }
+  reproject = reprojectHelper fm_utctimes
+  reproject' = reproject'Helper fm_utctimes
+  buildFMap' = buildFMap'Helper fm_utctimesA
hunk ./src/Database/Squiggle/Types.hs 586
-  reproject fm (SFField _ fn) v = (Safe.fromJustNote ("missing field " ++ show fn) $ psm_lookup fn $ fm_mutctimes fm) v
-  reproject' fm (SFField _ fn) = psm_lookup fn (fm_mutctimes fm)
-  buildFMap' (SFField _ fn) func fm = fm { fm_mutctimes = psm_insert fn func (fm_mutctimes fm) }
+  reproject = reprojectHelper fm_mutctimes
+  reproject' = reproject'Helper fm_mutctimes
+  buildFMap' = buildFMap'Helper fm_mutctimesA
hunk ./src/Database/Squiggle/Types.hs 3498
+
+{- TODO
+
+toSqlExpr is silly. Need something that really is a -> SqlExpr a
+
+-}
+
hunk ./src/Database/Squiggle/Types.hs 957
-instance SqlEq Int where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe Int) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq Bool where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe Bool) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq String where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe String) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq Char where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe Char) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq Date where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe Date) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq Double where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe Double) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq UTCTime where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
-
-instance SqlEq (Maybe UTCTime) where
-  x `eq` y = SEPrim SPEq `SEApp` x `SEApp` y
+x `primEq` y = SEPrim SPEq `SEApp` x `SEApp` y
hunk ./src/Database/Squiggle/Types.hs 959
+instance SqlEq Int             where eq = primEq
+instance SqlEq (Maybe Int)     where eq = primEq
+instance SqlEq Bool            where eq = primEq
+instance SqlEq (Maybe Bool)    where eq = primEq
+instance SqlEq String          where eq = primEq
+instance SqlEq (Maybe String)  where eq = primEq
+instance SqlEq Char            where eq = primEq
+instance SqlEq (Maybe Char)    where eq = primEq
+instance SqlEq Date            where eq = primEq
+instance SqlEq (Maybe Date)    where eq = primEq
+instance SqlEq Double          where eq = primEq
+instance SqlEq (Maybe Double)  where eq = primEq
+instance SqlEq UTCTime         where eq = primEq
+instance SqlEq (Maybe UTCTime) where eq = primEq
hunk ./src/Database/Squiggle/Types.hs 989
+x `primLt` y = SEPrim SPLt `SEApp` x `SEApp` y
+x `primGt` y = SEPrim SPGt `SEApp` x `SEApp` y
+x `primLe` y = SEPrim SPLe `SEApp` x `SEApp` y
+x `primGe` y = SEPrim SPGe `SEApp` x `SEApp` y
+
hunk ./src/Database/Squiggle/Types.hs 995
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./src/Database/Squiggle/Types.hs 1001
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./src/Database/Squiggle/Types.hs 1007
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./src/Database/Squiggle/Types.hs 1013
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./src/Database/Squiggle/Types.hs 1019
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./src/Database/Squiggle/Types.hs 1025
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./src/Database/Squiggle/Types.hs 1031
-  x `lt` y = SEPrim SPLt `SEApp` x `SEApp` y
-  x `gt` y = SEPrim SPGt `SEApp` x `SEApp` y
-  x `le` y = SEPrim SPLe `SEApp` x `SEApp` y
-  x `ge` y = SEPrim SPGe `SEApp` x `SEApp` y
+  lt = primLt
+  gt = primGt
+  le = primLe
+  ge = primGe
hunk ./squiggle.cabal 3
-license:	 GPL
+license:	 BSD3
hunk ./squiggle.cabal 6
-description:	 Help keep track of cash
-exposed-modules:
+description:	 Typed SQL EDSL
+exposed-modules: Database.Squiggle.Types, Database.Squiggle.MkInstances, Database.Squiggle.MySQL
+hs-source-dirs:  src
hunk ./squiggle.cabal 10
-build-depends:	 base, data-accessor, hsql, hsql-mysql, HDBC, time, Safe, HDBC-mysql
+build-depends:	 base, data-accessor, hsql, hsql-mysql, HDBC, time, Safe, HDBC-mysql, convertible,
+                 pretty, containers, mtl, template-haskell
hunk ./squiggle.cabal 14
-buildable: False
+
hunk ./squiggle.cabal 10
-build-depends:	 base, data-accessor, hsql, hsql-mysql, HDBC, time, Safe, HDBC-mysql, convertible,
+build-depends:	 base >= 4.0 && < 5.0,
+                 data-accessor, hsql, hsql-mysql, HDBC, time, Safe, HDBC-mysql, convertible,
hunk ./src/Database/Squiggle/MySQL.hs 2
-  OverloadedStrings, GADTs #-}
+  OverloadedStrings, GADTs, ScopedTypeVariables #-}
hunk ./src/Database/Squiggle/MySQL.hs 5
+import Prelude hiding ( catch )
+
+import Control.Exception
hunk ./src/Database/Squiggle/MySQL.hs 22
-   goC db sql = flip HDBC.catchSql (fail . show) $ do
+   goC db sql = HDBC.handleSqlError $ do
hunk ./src/Database/Squiggle/MySQL.hs 27
-   goQ db (sql, fields) = flip HDBC.catchSql (fail . show) $ do
+   goQ db (sql, fields) = HDBC.handleSqlError $ do
hunk ./src/Database/Squiggle/MySQL.hs 46
+handleHSQLError = flip catch (\(x :: HSQL.SqlError) -> fail . show $ x)
+
hunk ./src/Database/Squiggle/MySQL.hs 49
-   goC db sql = flip HSQL.catchSql (fail . show) $ do
+   goC db sql = handleHSQLError $ do
hunk ./src/Database/Squiggle/MySQL.hs 53
-   goQ db (sql, fields) = flip HSQL.catchSql (fail . show) $ do
+   goQ db (sql, fields) = handleHSQLError $ do
hunk ./src/Database/Squiggle/Types.hs 1
-{-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, RankNTypes, TypeFamilies, NoMonomorphismRestriction, TypeSynonymInstances, PatternSignatures, PatternGuards #-}
+{-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, RankNTypes, TypeFamilies, NoMonomorphismRestriction, TypeSynonymInstances, PatternGuards #-}
hunk ./src/Database/Squiggle/Types.hs 1209
-  fromSqlValue typ field = error "TODO: HSQL binding for UTCTime"
hunk ./src/Database/Squiggle/Types.hs 29
-import Database.HSQL
-import Database.HSQL.Types
+import qualified Database.HSQL as HSQL
+import qualified Database.HSQL.Types as HSQL
hunk ./src/Database/Squiggle/Types.hs 1191
-class (Show a, Eq a, SqlEq a, SqlBind a, SqlBE a, Convertible HDBC.SqlValue a) => SqlPrimType a where
+class (Show a, Eq a, SqlEq a, SqlBE a, HSQL.SqlBind a, Convertible HDBC.SqlValue a) => SqlPrimType a where
hunk ./src/Database/Squiggle/Types.hs 1198
-instance SqlBind Char where
-  fromSqlValue typ field = fmap head (fromSqlValue typ field)
+instance HSQL.SqlBind Char where
+  fromSqlValue typ field = fmap head (HSQL.fromSqlValue typ field)
hunk ./src/Database/Squiggle/Types.hs 1201
-instance SqlBind Date where
-  fromSqlValue typ field = fmap mkDate (fromSqlValue typ field)
+instance HSQL.SqlBind Date where
+  fromSqlValue typ field = fmap mkDate (HSQL.fromSqlValue typ field)
hunk ./src/Database/Squiggle/Types.hs 1208
-instance SqlBind UTCTime where
+instance HSQL.SqlBind UTCTime where
hunk ./src/Database/Squiggle/MySQL.hs 9
+import Data.Convertible
hunk ./src/Database/Squiggle/MySQL.hs 11
+import Data.Time.Calendar
+import Data.Time.Clock
+import qualified Database.HSQL as HSQL
+import qualified Database.HSQL.Types as HSQL
hunk ./src/Database/Squiggle/MySQL.hs 43
-      readFields' (SFField _ _) (v:vs) = (HDBC.fromSql v, vs)
+      readFields' (SFField _ _) (v:vs) = (fromSql sqlPrimWitness v, vs)
hunk ./src/Database/Squiggle/MySQL.hs 50
+      fromSql :: SqlPrimWitness a -> HDBC.SqlValue -> a
+      fromSql SPWBool = HDBC.fromSql
+      fromSql SPWChar = HDBC.fromSql
+      fromSql SPWInt = HDBC.fromSql
+      fromSql SPWString = HDBC.fromSql
+      fromSql SPWDouble = HDBC.fromSql
+      fromSql SPWDate = HDBC.fromSql
+      fromSql SPWUTCTime = HDBC.fromSql
+      fromSql (SPWMaybe SPWBool) = HDBC.fromSql
+      fromSql (SPWMaybe SPWChar) = HDBC.fromSql
+      fromSql (SPWMaybe SPWInt) = HDBC.fromSql
+      fromSql (SPWMaybe SPWString) = HDBC.fromSql
+      fromSql (SPWMaybe SPWDouble) = HDBC.fromSql
+      fromSql (SPWMaybe SPWDate) = HDBC.fromSql
+      fromSql (SPWMaybe SPWUTCTime) = HDBC.fromSql
+
+instance Convertible HDBC.SqlValue Date where
+  safeConvert value = fmap mkDate (safeConvert value)
+    where
+      mkDate day = let (y, m, d) = toGregorian (day :: Day)
+                   in Date (fromInteger y, m, d)
+
+
+instance HSQL.SqlBind Char where
+  fromSqlValue typ field = fmap head (HSQL.fromSqlValue typ field)
+
+instance HSQL.SqlBind Date where
+  fromSqlValue typ field = fmap mkDate (HSQL.fromSqlValue typ field)
+   where
+      mkDate str = Date (read (take 4 str),
+                         read (take 2 (drop 5 str)),
+                         read (take 2 (drop 8 str)))
+
+instance HSQL.SqlBind UTCTime where
hunk ./src/Database/Squiggle/MySQL.hs 97
-      retr stmt (SFField _ x) = HSQL.getFieldValue stmt (unFieldName x)
+      retr stmt (SFField _ x) = getFieldValue sqlPrimWitness stmt (unFieldName x)
hunk ./src/Database/Squiggle/MySQL.hs 101
+      getFieldValue :: SqlPrimWitness a -> HSQL.Statement -> String -> IO a
+      getFieldValue SPWBool = HSQL.getFieldValue
+      getFieldValue SPWChar = HSQL.getFieldValue
+      getFieldValue SPWInt = HSQL.getFieldValue
+      getFieldValue SPWString = HSQL.getFieldValue
+      getFieldValue SPWDouble = HSQL.getFieldValue
+      getFieldValue SPWDate = HSQL.getFieldValue
+      getFieldValue SPWUTCTime = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWBool) = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWChar) = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWInt) = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWString) = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWDouble) = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWDate) = HSQL.getFieldValue
+      getFieldValue (SPWMaybe SPWUTCTime) = HSQL.getFieldValue
+
hunk ./src/Database/Squiggle/Types.hs 29
-import qualified Database.HSQL as HSQL
-import qualified Database.HSQL.Types as HSQL
-
-import Data.Convertible
-import qualified Database.HDBC as HDBC
-
hunk ./src/Database/Squiggle/Types.hs 640
+data SqlPrimWitness a where
+  SPWBool :: SqlPrimWitness Bool
+  SPWChar :: SqlPrimWitness Char
+  SPWInt :: SqlPrimWitness Int
+  SPWString :: SqlPrimWitness String
+  SPWDouble :: SqlPrimWitness Double
+  SPWDate :: SqlPrimWitness Date
+  SPWUTCTime :: SqlPrimWitness UTCTime
+
+  SPWMaybe :: SqlPrimWitness a -> SqlPrimWitness (Maybe a)
+
hunk ./src/Database/Squiggle/Types.hs 1196
-class (Show a, Eq a, SqlEq a, SqlBE a, HSQL.SqlBind a, Convertible HDBC.SqlValue a) => SqlPrimType a where
+class (Show a, Eq a, SqlEq a, SqlBE a) => SqlPrimType a where
+  sqlPrimWitness :: SqlPrimWitness a
hunk ./src/Database/Squiggle/Types.hs 1204
-instance HSQL.SqlBind Char where
-  fromSqlValue typ field = fmap head (HSQL.fromSqlValue typ field)
-
-instance HSQL.SqlBind Date where
-  fromSqlValue typ field = fmap mkDate (HSQL.fromSqlValue typ field)
-   where
-      mkDate str = Date (read (take 4 str),
-                         read (take 2 (drop 5 str)),
-                         read (take 2 (drop 8 str)))
-
-instance HSQL.SqlBind UTCTime where
-
-instance Convertible HDBC.SqlValue Date where
-  safeConvert value = fmap mkDate (safeConvert value)
-    where
-      mkDate day = let (y, m, d) = toGregorian (day :: Day)
-                   in Date (fromInteger y, m, d)
-
hunk ./src/Database/Squiggle/Types.hs 1205
+  sqlPrimWitness = SPWMaybe sqlPrimWitness
hunk ./src/Database/Squiggle/Types.hs 1213
+  sqlPrimWitness = SPWInt
hunk ./src/Database/Squiggle/Types.hs 1219
+  sqlPrimWitness = SPWBool
hunk ./src/Database/Squiggle/Types.hs 1226
+  sqlPrimWitness = SPWString
hunk ./src/Database/Squiggle/Types.hs 1232
+  sqlPrimWitness = SPWChar
hunk ./src/Database/Squiggle/Types.hs 1238
+  sqlPrimWitness = SPWDate
hunk ./src/Database/Squiggle/Types.hs 1244
+  sqlPrimWitness = SPWDouble
hunk ./src/Database/Squiggle/Types.hs 1250
+  sqlPrimWitness = SPWUTCTime