support recent versions of GHC/base and other dependencies

bravit · Oct 23, 2023 · fd9a713 · fd9a713
1 parent 61bad27
commit fd9a713
Show file tree

Hide file tree

Showing 20 changed files with 625 additions and 409 deletions.
diff --git a/cabal.project.local b/cabal.project.local
@@ -3,4 +3,4 @@ tests: True
 allow-newer: base
 allow-newer: Cabal
 allow-newer: random
--- flags: with-pg
+-- flags: +with-pg
diff --git a/ch05/dicegame.hs b/ch05/dicegame.hs
@@ -1,3 +1,4 @@
+import Control.Monad
 import Control.Monad.RWS
 import System.Random
 

diff --git a/ch05/gcd.hs b/ch05/gcd.hs
@@ -1,3 +1,4 @@
+import Data.Monoid
 import Control.Monad.Writer
 
 gcd' :: Integral a => a -> a -> a

diff --git a/ch05/reader.hs b/ch05/reader.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 
+import Control.Monad
 import Control.Monad.Reader
 
 data Config = Config {

diff --git a/ch05/weapons.hs b/ch05/weapons.hs
@@ -1,4 +1,5 @@
 import Data.List (group, sort)
+import Control.Monad
 import Control.Monad.State
 import System.Random
 import System.Random.Stateful (uniformRM, uniformM)

diff --git a/ch12/th/projectors/Projectors.hs b/ch12/th/projectors/Projectors.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+
 module Projectors where
 
 import Language.Haskell.TH
@@ -52,10 +53,13 @@ mkProjType n k = sigD nm funTy
   where
     nm = mkProjName n k
 
+    plainTV' :: Name -> TyVarBndr Specificity
+    plainTV' name = PlainTV name specifiedSpec
+
     funTy = do
       resTy <- newName "res"
       tys <- mapM (getTy resTy) [0..n-1]
-      forallT (map plainTV tys)
+      forallT (map plainTV' tys)
               (pure [])
               [t| $(mkTuple tys) -> $(varT resTy) |]
 

diff --git a/ch13/doors/SingGen.hs b/ch13/doors/SingGen.hs
@@ -15,7 +15,7 @@
 #endif
 
 
-import Data.Singletons.TH
+import Data.Singletons.Base.TH
 
 $(singletons [d|
  data DoorState = Opened | Closed

diff --git a/ch13/elevator/Elevator/Safe/Operations.hs b/ch13/elevator/Elevator/Safe/Operations.hs
@@ -22,7 +22,7 @@
 module Elevator.Safe.Operations where
 
 import Data.Type.Nat
-import Data.Singletons.TH
+import Data.Singletons.Base.TH
 import Control.Monad.Trans
 
 import qualified Elevator.LowLevel as LL

diff --git a/ch15/opaleye/DBActions.hs b/ch15/opaleye/DBActions.hs
@@ -37,13 +37,13 @@ filmsCategories conn films = catMaybes <$> mapM runSingle films
                      runSelect conn (Q.filmCategories filmTitle)
 
 setRating :: Connection -> Rating -> Text -> IO Int64
-setRating conn r filmTitle = runUpdate_ conn (Q.setRating r filmTitle)
+setRating conn r filmTitle = runUpdate conn (Q.setRating r filmTitle)
 
 findOrAddCategory :: Connection -> Text -> IO [CatId]
 findOrAddCategory conn catName = do
   cats <- runSelect conn (Q.catIdByName catName)
   case cats of
-    [] -> runInsert_ conn (Q.newCategory catName)
+    [] -> runInsert conn (Q.newCategory catName)
     (cid:_) -> pure [cid]
 
 isAssigned :: Connection -> CatId -> FilmId -> IO Bool
@@ -56,7 +56,7 @@ assignUnlessAssigned conn cid fid = do
   b <- isAssigned conn cid fid
   case b of
     True -> pure 0
-    False -> runInsert_ conn (Q.assignCategory cid fid)
+    False -> runInsert conn (Q.assignCategory cid fid)
 
 assignCategory :: Connection -> Text -> Text -> IO Int64
 assignCategory conn catName filmTitle = do
@@ -71,5 +71,5 @@ unassignCategory conn catName filmTitle = do
   catIds <- runSelect conn (Q.catIdByName catName)
   filmIds <- runSelect conn (Q.filmIdByTitle filmTitle)
   case (catIds, filmIds) of
-    ([cid], [fid]) -> runDelete_ conn (Q.unassignCategory cid fid)
+    ([cid], [fid]) -> runDelete conn (Q.unassignCategory cid fid)
     _ -> pure 0
diff --git a/ch15/opaleye/Tables.hs b/ch15/opaleye/Tables.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Tables where
 
@@ -25,8 +26,8 @@ instance DefaultFromField PGRating Rating where
 
 instance pgf ~ FieldNullable PGRating => Default ToFields Rating pgf where
   def = dimap fromRating
-              (unsafeCast "mpaa_rating")
-              (def :: ToFields Text (Field PGText))
+              (unsafeCoerceColumn . unsafeCast "mpaa_rating")
+              (def :: ToFields Text (Field SqlText))
 
 makeAdaptorAndInstanceInferrable "pFilmId" ''FilmId'
 makeAdaptorAndInstanceInferrable "pFilmLength" ''FilmLength'

diff --git a/du/AppTypes.hs b/du/AppTypes.hs
@@ -17,7 +17,7 @@ data AppEnv = AppEnv {
   }
 
 initialEnv :: AppConfig -> AppEnv
-initialEnv config @ AppConfig {..} = AppEnv {
+initialEnv config@AppConfig {..} = AppEnv {
     cfg = config
   , path = basePath
   , depth = 0

diff --git a/expr/ShuntingYard.hs b/expr/ShuntingYard.hs
@@ -3,6 +3,7 @@ module ShuntingYard (convertToExpr) where
 import Data.Char (isDigit, isSpace)
 import Data.List (groupBy)
 import Data.Foldable (traverse_)
+import Control.Monad
 import Control.Monad.State
 
 import Expr

diff --git a/expr/rpn/EvalRPNExcept.hs b/expr/rpn/EvalRPNExcept.hs
@@ -2,6 +2,7 @@
 
 module EvalRPNExcept where
 
+import Control.Monad
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Except

diff --git a/expr/rpn/EvalRPNTrans.hs b/expr/rpn/EvalRPNTrans.hs
@@ -1,5 +1,6 @@
 module EvalRPNTrans where
 
+import Control.Monad
 import Control.Monad.State
 import Control.Applicative
 import Text.Read (readMaybe)

diff --git a/expr/rpn/EvalRPNTrans2.hs b/expr/rpn/EvalRPNTrans2.hs
@@ -1,5 +1,6 @@
 module EvalRPNTrans2 where
 
+import Control.Monad
 import Control.Monad.State
 import Control.Applicative
 import Text.Read (readMaybe)