diff --git a/test/Common/Test.hs b/test/Common/Test.hs
index d45a401..1620bcf 100644
--- a/test/Common/Test.hs
+++ b/test/Common/Test.hs
@@ -55,9 +55,13 @@ module Common.Test
     , Numbers (..)
     , OneUnique(..)
     , Unique(..)
+    , DateTruncTest(..)
+    , DateTruncTestId
+    , Key(..)
     ) where
 
 import Data.Either
+import Data.Time
 import Control.Monad (forM_, replicateM, replicateM_, void)
 import Control.Monad.Reader (ask)
 import Control.Monad.Catch (MonadCatch)
@@ -229,6 +233,10 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
     joinOther JoinOtherId
     joinOne   JoinOneId
     deriving Eq Show
+
+  DateTruncTest
+    created   UTCTime
+    deriving Eq Show
 |]
 
 -- Unique Test schema
@@ -862,10 +870,10 @@ testSelectSubQuery run = do
     it "works" $ do
       run $ do
         _ <- insert' p1
-        let q = do 
+        let q = do
                 p <- Experimental.from $ Table @Person
                 return ( p ^. PersonName, p ^. PersonAge)
-        ret <- select $ Experimental.from $ SelectQuery q        
+        ret <- select $ Experimental.from $ SelectQuery q
         liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ]
 
     it "lets you order by alias" $ do
@@ -873,8 +881,8 @@ testSelectSubQuery run = do
         _ <- insert' p1
         _ <- insert' p3
         let q = do
-                (name, age) <- 
-                  Experimental.from $ SubQuery $ do 
+                (name, age) <-
+                  Experimental.from $ SubQuery $ do
                       p <- Experimental.from $ Table @Person
                       return ( p ^. PersonName, p ^. PersonAge)
                 orderBy [ asc age ]
@@ -889,14 +897,14 @@ testSelectSubQuery run = do
         mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
 
         mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int])
-        let q = do 
-                (lord :& deed) <- Experimental.from $ Table @Lord 
+        let q = do
+                (lord :& deed) <- Experimental.from $ Table @Lord
                                         `InnerJoin` Table @Deed
-                                  `Experimental.on` (\(lord :& deed) -> 
+                                  `Experimental.on` (\(lord :& deed) ->
                                                        lord ^. LordId ==. deed ^. DeedOwnerId)
                 return (lord ^. LordId, deed ^. DeedId)
             q' = do
-                 (lordId, deedId) <- Experimental.from $ SubQuery q 
+                 (lordId, deedId) <- Experimental.from $ SubQuery q
                  groupBy (lordId)
                  return (lordId, count deedId)
         (ret :: [(Value (Key Lord), Value Int)]) <- select q'
@@ -912,16 +920,16 @@ testSelectSubQuery run = do
 
         mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int])
         let q = do
-                (lord :& deed) <- Experimental.from $ Table @Lord 
+                (lord :& deed) <- Experimental.from $ Table @Lord
                                         `InnerJoin` Table @Deed
                                   `Experimental.on` (\(lord :& deed) ->
                                                       lord ^. LordId ==. deed ^. DeedOwnerId)
                 groupBy (lord ^. LordId)
                 return (lord ^. LordId, count (deed ^. DeedId))
 
-        (ret :: [(Value Int)]) <- select $ do 
-                 (lordId, deedCount) <- Experimental.from $ SubQuery q 
-                 where_ $ deedCount >. val (3 :: Int) 
+        (ret :: [(Value Int)]) <- select $ do
+                 (lordId, deedCount) <- Experimental.from $ SubQuery q
+                 where_ $ deedCount >. val (3 :: Int)
                  return (count lordId)
 
         liftIO $ ret `shouldMatchList` [ (Value 1) ]
@@ -933,10 +941,10 @@ testSelectSubQuery run = do
         mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
 
         mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int])
-        let q = do 
+        let q = do
                 (lord :& deed) <- Experimental.from $ Table @Lord
                         `InnerJoin` (SelectQuery $ Experimental.from $ Table @Deed)
-                        `Experimental.on` (\(lord :& deed) -> 
+                        `Experimental.on` (\(lord :& deed) ->
                                              lord ^. LordId ==. deed ^. DeedOwnerId)
                 groupBy (lord ^. LordId)
                 return (lord ^. LordId, count (deed ^. DeedId))
@@ -965,19 +973,19 @@ testSelectSubQuery run = do
         run $ do
           _ <- insert p1
           _ <- insert p2
-          let q = Experimental.from $ 
-                  (SelectQuery $ do  
+          let q = Experimental.from $
+                  (SelectQuery $ do
                     p <- Experimental.from $ Table @Person
                     where_ $ not_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
                   `Union`
                   (SelectQuery $ do
-                    p <- Experimental.from $ Table @Person 
+                    p <- Experimental.from $ Table @Person
                     where_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
                   `Union`
-                  (SelectQuery $ do 
-                    p <- Experimental.from $ Table @Person 
+                  (SelectQuery $ do
+                    p <- Experimental.from $ Table @Person
                     where_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
           names <- select q
@@ -2409,7 +2417,7 @@ testExperimentalFrom run = do
         p1e <- insert' p1
         _   <- insert' p2
         p3e <- insert' p3
-        peopleWithAges <- select $ do 
+        peopleWithAges <- select $ do
           people <- Experimental.from $ Table @Person
           where_ $ not_ $ isNothing $ people ^. PersonAge
           return people
@@ -2422,7 +2430,7 @@ testExperimentalFrom run = do
         d1e <- insert' $ Deed "1" (entityKey l1e)
         d2e <- insert' $ Deed "2" (entityKey l1e)
         lordDeeds <- select $ do
-          (lords :& deeds) <- 
+          (lords :& deeds) <-
             Experimental.from $ Table @Lord
                     `InnerJoin` Table @Deed
               `Experimental.on` (\(l :& d) -> l ^. LordId ==. d ^. DeedOwnerId)
@@ -2438,11 +2446,11 @@ testExperimentalFrom run = do
         d1e <- insert' $ Deed "1" (entityKey l1e)
         d2e <- insert' $ Deed "2" (entityKey l1e)
         lordDeeds <- select $ do
-          (lords :& deeds) <- 
+          (lords :& deeds) <-
             Experimental.from $ Table @Lord
                 `LeftOuterJoin` Table @Deed
                   `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
-                                
+
           pure (lords, deeds)
         liftIO $ lordDeeds `shouldMatchList` [ (l1e, Just d1e)
                                              , (l1e, Just d2e)
@@ -2465,7 +2473,7 @@ testExperimentalFrom run = do
           lords1 <- Experimental.from $ Table @Lord
           lords2 <- Experimental.from $ Table @Lord
           pure (lords1, lords2)
-        ret2 <- select $ do 
+        ret2 <- select $ do
           (lords1 :& lords2) <- Experimental.from $ Table @Lord `CrossJoin` Table @Lord
           pure (lords1,lords2)
         liftIO $ ret `shouldMatchList` ret2
@@ -2474,23 +2482,23 @@ testExperimentalFrom run = do
                                        , (l2e, l1e)
                                        , (l2e, l2e)
                                        ]
-          
+
 
     it "compiles" $ do
-      run $ void $ do 
-        let q = do 
-              (persons :& profiles :& posts) <- 
-                Experimental.from $  Table @Person 
+      run $ void $ do
+        let q = do
+              (persons :& profiles :& posts) <-
+                Experimental.from $  Table @Person
                          `InnerJoin` Table @Profile
-                   `Experimental.on` (\(people :& profiles) -> 
-                                        people ^. PersonId ==. profiles ^. ProfilePerson) 
+                   `Experimental.on` (\(people :& profiles) ->
+                                        people ^. PersonId ==. profiles ^. ProfilePerson)
                      `LeftOuterJoin` Table @BlogPost
-                   `Experimental.on` (\(people :& _ :& posts) -> 
-                                        just (people ^. PersonId) ==. posts ?. BlogPostAuthorId) 
+                   `Experimental.on` (\(people :& _ :& posts) ->
+                                        just (people ^. PersonId) ==. posts ?. BlogPostAuthorId)
               pure (persons, posts, profiles)
         --error . show =<< renderQuerySelect q
         pure ()
-        
+
 
 listsEqualOn :: (Show a1, Eq a1) => [a2] -> [a2] -> (a2 -> a1) -> Expectation
 listsEqualOn a b f = map f a `shouldBe` map f b
@@ -2584,6 +2592,8 @@ cleanDB = do
   delete $ from $ \(_ :: SqlExpr (Entity JoinOne))    -> return ()
   delete $ from $ \(_ :: SqlExpr (Entity JoinOther))    -> return ()
 
+  delete $ from $ \(_ :: SqlExpr (Entity DateTruncTest)) -> pure ()
+
 
 cleanUniques
   :: (forall m. RunDbMonad m
diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs
index 2b7b99e..8b561e6 100644
--- a/test/PostgreSQL/Test.hs
+++ b/test/PostgreSQL/Test.hs
@@ -7,9 +7,15 @@
            , ScopedTypeVariables
            , TypeApplications
            , TypeFamilies
+           , PartialTypeSignatures
  #-}
 module Main (main) where
 
+import Data.Coerce
+import Data.Foldable
+import qualified Data.Map.Strict as Map
+import Data.Map (Map)
+import Data.Time
 import Control.Arrow ((&&&))
 import Control.Monad (void, when)
 import Control.Monad.Catch (MonadCatch, catch)
@@ -36,6 +42,7 @@ import Database.Persist.Postgresql (withPostgresqlConn)
 import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..))
 import System.Environment
 import Test.Hspec
+import Test.Hspec.QuickCheck
 
 import Common.Test
 import PostgreSQL.MigrateJSON
@@ -52,10 +59,6 @@ testPostgresqlCoalesce = do
         return (coalesce [p ^. PersonAge])
       return ()
 
-
-
-
-
 nameContains :: (BaseBackend backend ~ SqlBackend,
                  BackendCompatible SqlBackend backend,
                  MonadIO m, SqlString s,
@@ -486,6 +489,52 @@ testAggregateFunctions = do
 
 testPostgresModule :: Spec
 testPostgresModule = do
+  describe "date_trunc" $ do
+    prop "works" $ \listOfDateParts -> run $ do
+      let
+        utcTimes =
+          map
+            (\(y, m, d, s) ->
+              fromInteger s
+                `addUTCTime`
+                  UTCTime (fromGregorian (2000 + y) m d) 0
+            )
+          listOfDateParts
+        truncateDate
+          :: SqlExpr (Value String)  -- ^ .e.g (val "day")
+          -> SqlExpr (Value UTCTime) -- ^ input field
+          -> SqlExpr (Value UTCTime) -- ^ truncated date
+        truncateDate datePart expr =
+          ES.unsafeSqlFunction "date_trunc" (datePart, expr)
+        vals =
+          zip (map (DateTruncTestKey . fromInteger) [1..]) utcTimes
+      for_ vals $ \(idx, utcTime) -> do
+        insertKey idx (DateTruncTest utcTime)
+
+      ret <-
+        fmap (Map.fromList . coerce :: _ -> Map DateTruncTestId (UTCTime, UTCTime)) $
+        select $
+        from $ \dt -> do
+        pure
+          ( dt ^. DateTruncTestId
+          , ( dt ^. DateTruncTestCreated
+            , truncateDate (val "day") (dt ^. DateTruncTestCreated)
+            )
+          )
+
+      liftIO $ for_ vals $ \(idx, utcTime) -> do
+        case Map.lookup idx ret of
+          Nothing ->
+            expectationFailure "index not found"
+          Just (original, expected) -> do
+            utcTime `shouldBe` original
+            if utctDay utcTime == utctDay expected
+              then
+                utctDay utcTime `shouldBe` utctDay expected
+              else
+                -- use this if/else to get a beter error message
+                utcTime `shouldBe` expected
+
   describe "PostgreSQL module" $ do
     describe "Aggregate functions" testAggregateFunctions
     it "chr looks sane" $