Cosmetics for GHC 9.14

.github/workflows/haskell-ci.yml

@@ -32,6 +32,11 @@ jobs:
     strategy:
       matrix:
         include:
+          - compiler: ghc-9.14.0.20250819
+            compilerKind: ghc
+            compilerVersion: 9.14.0.20250819
+            setup-method: ghcup-prerelease
+            allow-failure: false
           - compiler: ghc-9.12.2
             compilerKind: ghc
             compilerVersion: 9.12.2
@@ -126,6 +131,21 @@ jobs:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
           HCVER: ${{ matrix.compilerVersion }}
+      - name: Install GHC (GHCup prerelease)
+        if: matrix.setup-method == 'ghcup-prerelease'
+        run: |
+          "$HOME/.ghcup/bin/ghcup" config add-release-channel prereleases
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+          HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
+          HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
+          HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
+          echo "HC=$HC" >> "$GITHUB_ENV"
+          echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
+          echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
+        env:
+          HCKIND: ${{ matrix.compilerKind }}
+          HCNAME: ${{ matrix.compiler }}
+          HCVER: ${{ matrix.compilerVersion }}
       - name: Set PATH and environment variables
         run: |
           echo "$HOME/.cabal/bin" >> $GITHUB_PATH
@@ -136,7 +156,7 @@ jobs:
           echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
           echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
           echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
-          echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
+          if [ $((HCNUMVER >= 91400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi
           echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
         env:
           HCKIND: ${{ matrix.compilerKind }}
@@ -164,6 +184,18 @@ jobs:
           repository hackage.haskell.org
             url: http://hackage.haskell.org/
           EOF
+          if $HEADHACKAGE; then
+          cat >> $CABAL_CONFIG <<EOF
+          repository head.hackage.ghc.haskell.org
+             url: https://ghc.gitlab.haskell.org/head.hackage/
+             secure: True
+             root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d
+                        26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
+                        f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
+             key-threshold: 3
+          active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override
+          EOF
+          fi
           cat >> $CABAL_CONFIG <<EOF
           program-default-options
             ghc-options: $GHCJOBS +RTS -M3G -RTS
@@ -215,9 +247,11 @@ jobs:
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project ; fi
           if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package happstack-server" >> cabal.project ; fi
           if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "    ghc-options: -Werror=unused-packages" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package happstack-server" >> cabal.project ; fi
           cat >> cabal.project <<EOF
           EOF
+          if $HEADHACKAGE; then
+          echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project
+          fi
           $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(happstack-server)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local

attic/Examples/AllIn.hs

@@ -16,7 +16,7 @@ import Happstack.Data.IxSet
 import qualified Data.Map as M
 
 ------------------------------------------------
--- Define a component of state 
+-- Define a component of state
 --
 -- Real examples are HelpReqs, FlashMsgs, and sessions
 -- really you should put components in their own modules.
@@ -29,15 +29,13 @@ import qualified Data.Map as M
 -- Lets start with defining a simple state component: Session
 type SesKey = Integer
 type ETime = Integer
-newtype OldSession val = OldSession {old_unsession::[(SesKey,(ETime,val))]} 
-                   deriving (Typeable)
+newtype OldSession val = OldSession {old_unsession::[(SesKey,(ETime,val))]}
 
 instance Version (OldSession val)
 $(deriveSerialize ''OldSession)
 
 
 newtype Session val = Session { unsession :: M.Map SesKey (ETime,val) }
-                   deriving (Typeable)
 
 instance Migrate (OldSession val) (Session val) where
     migrate (OldSession sess) = Session (M.fromList sess)
@@ -71,7 +69,7 @@ getSession :: SesKey -> Query (Session val) (Maybe val)
 getSession key = do val <- liftM (M.lookup key) askSession
                     return (liftM snd val)
 
-setSession key val = do 
+setSession key val = do
                      t <- getTime
                      modSession $ M.insert key (t,val)
                      return ()
@@ -97,30 +95,30 @@ numSessions = proxyQuery $ liftM M.size askSession
 
 -- Declare these as methods. So you can access them from any IO via (query $
 -- GetSession key) or (update $ setSession key val).  When we can have
--- Data for phantom types in 6.8.2 this will look nicer 
+-- Data for phantom types in 6.8.2 this will look nicer
 
-$(mkMethods ''Session 
-  ['newSession,'setSession, 'cleanSessions,'numSessions ,'getSession]) 
+$(mkMethods ''Session
+  ['newSession,'setSession, 'cleanSessions,'numSessions ,'getSession])
 
 -- Sometimes you want maintenance on your component that the user
 -- doesn't want to worry about.
 
 maintainSessions v = do update $ CleanSessions 3600000 v
                         threadDelay (10^6 * 10) -- Once every 10 seconds
-                        maintainSessions v 
+                        maintainSessions v
 
 instance (Serialize a) => Component (Session a) where
     type Dependencies (Session a) = End
     initialValue = Session M.empty
 
--- All components need an atStart declaration though the list can be empty              
+-- All components need an atStart declaration though the list can be empty
 
 -- Now we repeat the above for a more trivial example so we have
--- multiple components in state.  But we'll use the more concise deriveAll syntax 
+-- multiple components in state.  But we'll use the more concise deriveAll syntax
 -- so you don't deal with the boilerplate of a zillion deriving declarations on each type.
 
-data UserComponent key = UserComponent {unUserComponent :: key} deriving (Typeable)
-data SingletonComponent = SingletonComponent {unSingleton :: String} deriving (Typeable)
+data UserComponent key = UserComponent {unUserComponent :: key}
+data SingletonComponent = SingletonComponent {unSingleton :: String}
 
 instance Version (UserComponent key)
 $(deriveSerialize ''UserComponent)
@@ -183,7 +181,7 @@ $(deriveAll [''Show,''Default, ''Read]
 
 data State = State { privateInt     :: Int
                    , privateString  :: String
-                   } deriving (Typeable)
+                   }
 
 instance Version State
 $(deriveSerialize ''State)
@@ -227,7 +225,7 @@ impl = dir "setGet" $ msum
              mbComp <- getData
              comp <- maybe mzero return mbComp
              liftIO $ update $ SetComponent (comp :: Int)
-             ok comp -- returned as <?xml v=1.0?><component>blah</component>. 
+             ok comp -- returned as <?xml v=1.0?><component>blah</component>.
              -- add the xslt wrapper to style the xml
              -- or write your own ToMessage instance for your return types
         ]

attic/Examples/DistributedChat/DistributedChat.hs

@@ -4,7 +4,6 @@ module Main (main) where
 import Happstack.State
 import Happstack.Server
 
-import Data.Typeable          ( Typeable )
 import System.Environment     ( getArgs, getProgName )
 import System.Exit            ( exitWith, ExitCode(ExitFailure) )
 import Control.Monad.State    ( put, get)
@@ -21,7 +20,7 @@ type MessageId = Int
 data User = User { userNick     :: Nick
                  , userLastSeen :: MessageId }
 
-data ChatState = ChatState MessageId [ (Nick, Message, MessageId) ] deriving (Typeable)
+data ChatState = ChatState MessageId [ (Nick, Message, MessageId) ]
 instance Version ChatState
 $(deriveSerialize ''ChatState)
 
@@ -73,7 +72,7 @@ main = bracket (startSystemStateMultimaster rootState) closeTxControl $ \ctl ->
                      [ do
                           mbUser <- getDataFn getUserFromCookie
                           user <- maybe mzero return mbUser
-                          msum 
+                          msum
                             [ dir "send" $ do
                                   msg <- getDataFn (look "msg") >>= maybe mzero return
                                   update $ AddMessage (userNick user) msg
@@ -82,14 +81,14 @@ main = bracket (startSystemStateMultimaster rootState) closeTxControl $ \ctl ->
                                   (newLast, msgs) <- liftIO $ getMessages (userLastSeen user)
                                   addCookie (-1) (mkCookie "last" (show newLast))
                                   ok (toResponse (format msgs))
-                              
+
                             , dir "clear" $ do
                                   addCookie (-1) (mkCookie "last" (show 0))
                                   ok (toResponse "")
                             , fileServe [] "ChatRun.html"
                             ]
                       , dir "login" $ do
-                           nick <- getDataFn (look "nick") >>= maybe mzero return 
+                           nick <- getDataFn (look "nick") >>= maybe mzero return
                            addCookie (-1) (mkCookie "nick" nick)
                            addCookie (-1) (mkCookie "last" (show 0))
                            seeOther "/" (toResponse "")

attic/Examples/MultimasterTest1.hs

@@ -1,14 +1,13 @@
-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
 module Main where
 
 import Happstack.Server
 import Happstack.State
 
-import Data.Typeable
 import Control.Monad.State
 import Control.Monad.Reader
 
-data MyState = MyState Int deriving (Typeable)
+data MyState = MyState Int
 
 instance Version MyState
 $(deriveSerialize ''MyState)
@@ -42,4 +41,3 @@ main = do ctl <- startSystemStateMultimaster rootState
                                 seeOther "/" ""
               , do val <- query GetVal
                    ok $ "Value is: " ++ show val ]
-

attic/Examples/MultimasterTest2.hs

@@ -1,14 +1,13 @@
-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
 module Main where
 
 import Happstack.Server
 import Happstack.State
 
-import Data.Typeable
 import Control.Monad.State
 import Control.Monad.Reader
 
-data MyState = MyState Int deriving (Typeable)
+data MyState = MyState Int
 instance Version MyState
 $(deriveSerialize ''MyState)
 
@@ -41,4 +40,3 @@ main = do ctl <- startSystemStateMultimaster rootState
                                 seeOther "/" ""
               , do val <- query GetVal
                    ok $ "Value is: " ++ show val ]
-

attic/Examples/Timer.hs

@@ -3,12 +3,11 @@ module Timer where
 
 import Happstack.State
 import Happstack.Data
-import Data.Typeable
 import Data.Generics
 import Control.Monad.State (modify)
 import Control.Concurrent
 
-newtype Timer = Timer Int deriving (Typeable)
+newtype Timer = Timer Int
 instance Version Timer
 $(deriveSerialize ''Timer)
 

cabal.haskell-ci

@@ -1 +1,3 @@
 branches: master
+
+error-incomplete-patterns: False

happstack-server.cabal

@@ -13,6 +13,7 @@ Cabal-Version:       >= 1.10
 Extra-Source-Files:  tests/Happstack/Server/Tests.hs README.md
 
 tested-with:
+  GHC == 9.14.1
   GHC == 9.12.2
   GHC == 9.10.2
   GHC == 9.8.2

src/Happstack/Server/Cookie.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts #-}
 -- | Functions for creating, adding, and expiring cookies. To lookup cookie values see "Happstack.Server.RqData".
 module Happstack.Server.Cookie
     ( Cookie(..)
@@ -19,7 +19,7 @@ import Happstack.Server.Types           (Response, addHeader)
 -- | Add the 'Cookie' to 'Response'.
 --
 -- example
--- 
+--
 -- > main = simpleHTTP nullConf $
 -- >   do addCookie Session (mkCookie "name" "value")
 -- >      ok $ "You now have a session cookie."
@@ -33,7 +33,7 @@ addCookie life cookie =
       addHeaderM a v = composeFilter $ \res-> addHeader a v res
 
 -- | Add the list 'Cookie' to the 'Response'.
--- 
+--
 -- see also: 'addCookie'
 addCookies :: (MonadIO m, FilterMonad Response m) => [(CookieLife, Cookie)] -> m ()
 addCookies = mapM_ (uncurry addCookie)
@@ -44,5 +44,5 @@ addCookies = mapM_ (uncurry addCookie)
 -- >   do expireCookie "name"
 -- >      ok $ "The cookie has been expired."
 
-expireCookie :: (MonadIO m, FilterMonad Response m) => String -> m () 
+expireCookie :: (MonadIO m, FilterMonad Response m) => String -> m ()
 expireCookie name = addCookie Expired (mkCookie name "")

src/Happstack/Server/FileServe/BuildingBlocks.hs

@@ -59,7 +59,7 @@ import Control.Monad                (MonadPlus(mzero), msum)
 import Control.Monad.Trans          (MonadIO(liftIO))
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.ByteString.Char8 as S
-import Data.Data                    (Data, Typeable)
+import Data.Data                    (Data)
 import Data.List                    (sort)
 import Data.Maybe                   (fromMaybe)
 import           Data.Map           (Map)
@@ -523,7 +523,7 @@ browseIndex renderFn _serveFn _mimeFn _ixFiles localPath =
        listing <- renderFn localPath $ filter (/= ".") (sort c)
        ok $ toResponse $ listing
 
-data EntryKind = File | Directory | UnknownKind deriving (Eq, Ord, Read, Show, Data, Typeable, Enum)
+data EntryKind = File | Directory | UnknownKind deriving (Eq, Ord, Read, Show, Data, Enum)
 
 -- | a function to generate an HTML page showing the contents of a directory on the disk
 --
@@ -625,7 +625,7 @@ getMetaData localPath fp =
 -- | see 'serveDirectory'
 data Browsing
     = EnableBrowsing | DisableBrowsing
-      deriving (Eq, Enum, Ord, Read, Show, Data, Typeable)
+      deriving (Eq, Enum, Ord, Read, Show, Data)
 
 -- | Serve files and directories from a directory and its subdirectories using 'sendFile'.
 --