co-log · alaendle · Sep 14, 2023 · Jul 2, 2023 · Jul 2, 2023 · Jul 2, 2023
@@ -24,19 +24,24 @@ jobs:
           - 9.0.2
           - 9.2.8
           - 9.4.7
+          - 9.6.2
         exclude:
           - os: macOS-latest
             ghc: 8.10.7
           - os: macOS-latest
             ghc: 9.0.2
           - os: macOS-latest
             ghc: 9.2.8
+          - os: macOS-latest
+            ghc: 9.4.7
           - os: windows-latest
             ghc: 8.10.7
           - os: windows-latest
             ghc: 9.0.2
           - os: windows-latest
             ghc: 9.2.8
+          - os: windows-latest
+            ghc: 9.4.7
 
     steps:
     - uses: actions/checkout@v4

@@ -25,13 +25,14 @@ tested-with:         GHC == 8.10.7
                      GHC == 9.0.2
                      GHC == 9.2.8
                      GHC == 9.4.7
+                     GHC == 9.6.2
 
 source-repository head
   type:                git
   location:            https://github.com/kowainik/co-log.git
 
 common common-options
-  build-depends:       base >= 4.14 && < 4.18
+  build-depends:       base >= 4.14 && < 4.19
 
   ghc-options:         -Wall
                        -Wcompat
@@ -95,19 +96,20 @@ library
                            Colog.Pure
                            Colog.Rotation
 
-  build-depends:       ansi-terminal >= 0.10 && < 0.12
-                     , bytestring >= 0.10.8 && < 0.12
+  build-depends:       ansi-terminal >= 1.0 && < 1.1
+                     , bytestring >= 0.10.8 && < 0.13
                      , co-log-core ^>= 0.3
                      , containers >= 0.5.7 && < 0.7
                      , contravariant ^>= 1.5
                      , directory ^>= 1.3.0
-                     , exceptions >= 0.8.3
+                     , exceptions >= 0.8.3 && < 0.11
                      , filepath ^>= 1.4.1
                      , mtl >= 2.2.2 && < 2.4
-                     , text >= 1.2.3 && < 2.1
+                     , text >= 1.2.3 && < 2.2
                      , chronos ^>= 1.1 && < 1.2
                      , transformers >= 0.5 && < 0.7
-                     , typerep-map >= 0.5 && < 0.7
+                     , dependent-sum >= 0.7 && < 0.8
+                     , dependent-map >= 0.4 && < 0.5
                      , unliftio-core ^>= 0.2
                      , vector >= 0.12.0.3 && < 0.14
   if impl(ghc < 9.4.5)
@@ -120,7 +122,7 @@ executable play-colog
 
   build-depends:       co-log
                      , mtl
-                     , typerep-map
+                     , dependent-map
 
   ghc-options:         -threaded
                        -rtsopts
@@ -146,7 +148,7 @@ test-suite test-co-log
   import:              common-options
   build-depends:       co-log
                      , co-log-core
-                     , hedgehog >= 1.0 && < 1.3
+                     , hedgehog >= 1.0 && < 1.5
   hs-source-dirs:      test
   main-is:             Property.hs
   type:                exitcode-stdio-1.0
@@ -160,7 +162,7 @@ test-suite co-log-doctest
   hs-source-dirs:      test
   main-is:             Doctest.hs
 
-  build-depends:       doctest >= 0.16.0 && < 0.21
+  build-depends:       doctest >= 0.16.0 && < 0.23
                      , Glob ^>= 0.10.0
   ghc-options:         -threaded
 

@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedLabels      #-}
 {-# LANGUAGE TypeFamilies          #-}
 
 {- |
@@ -65,21 +64,21 @@ module Colog.Message
        , upgradeMessageAction
        ) where
 
-import Prelude hiding (log)
+import Prelude hiding (lookup, log)
 
 import Control.Concurrent (ThreadId, myThreadId)
 import Control.Exception (Exception, displayException)
 import Control.Monad.IO.Class (MonadIO (..))
+import Data.Dependent.Map (DMap, fromList, lookup)
+import Data.Dependent.Sum (DSum ((:=>)))
 import Data.Kind (Type)
 import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
-import Data.TypeRepMap (TypeRepMap)
-import GHC.Exts (IsList (..))
-import GHC.OverloadedLabels (IsLabel (..))
 import GHC.Stack (CallStack, SrcLoc (..), callStack, getCallStack, withFrozenCallStack)
-import GHC.TypeLits (KnownSymbol, Symbol)
+import GHC.TypeLits (Symbol)
 import System.Console.ANSI (Color (..), ColorIntensity (Vivid), ConsoleLayer (Foreground), SGR (..),
                             setSGRCode)
+import Type.Reflection (TypeRep, typeRep)
 
 import Colog.Core (LogAction, Severity (..), cmap)
 import Colog.Monad (WithLog, logMsg)
@@ -89,7 +88,6 @@ import qualified Chronos.Locale.English as C
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.Builder as TB
 import qualified Data.Text.Lazy.Builder.Int as TB
-import qualified Data.TypeRepMap as TM
 import qualified Data.Vector as Vector
 
 ----------------------------------------------------------------------------
@@ -297,15 +295,6 @@ unMessageField :: forall fieldName m . MessageField m fieldName -> m (FieldType
 unMessageField (MessageField f) = f
 {-# INLINE unMessageField #-}
 
-instance (KnownSymbol fieldName, a ~ m (FieldType fieldName))
-      => IsLabel fieldName (a -> TM.WrapTypeable (MessageField m)) where
-#if MIN_VERSION_base(4,11,0)
-    fromLabel field = TM.WrapTypeable $ MessageField @fieldName field
-#else
-    fromLabel field = TM.WrapTypeable $ MessageField  @_ @fieldName field
-#endif
-    {-# INLINE fromLabel #-}
-
 -- | Helper function to deal with 'MessageField' when looking it up in the 'FieldMap'.
 extractField
     :: Applicative m
@@ -322,7 +311,7 @@ extractField = traverse unMessageField
 {- | Depedent map from type level strings to the corresponding types. See
 'FieldType' for mapping between names and types.
 -}
-type FieldMap (m :: Type -> Type) = TypeRepMap (MessageField m)
+type FieldMap m = DMap TypeRep (MessageField m)
 
 {- | Default message map that contains actions to extract 'ThreadId' and
 'C.Time'. Basically, the following mapping:
@@ -334,8 +323,8 @@ type FieldMap (m :: Type -> Type) = TypeRepMap (MessageField m)
 -}
 defaultFieldMap :: MonadIO m => FieldMap m
 defaultFieldMap = fromList
-    [ #threadId  (liftIO myThreadId)
-    , #posixTime (liftIO C.now)
+    [ typeRep @"threadId"  :=> MessageField (liftIO myThreadId)
+    , typeRep @"posixTime" :=> MessageField (liftIO C.now)
     ]
 
 {- | Contains additional data to 'Message' to display more verbose information.
@@ -413,8 +402,8 @@ fmtRichMessageCustomDefault
     -> (Maybe ThreadId -> Maybe C.Time -> msg -> Text)
     -> m Text
 fmtRichMessageCustomDefault RichMsg{..} formatter = do
-    maybeThreadId  <- extractField $ TM.lookup @"threadId"  richMsgMap
-    maybePosixTime <- extractField $ TM.lookup @"posixTime" richMsgMap
+    maybeThreadId  <- extractField $ lookup (typeRep @"threadId")  richMsgMap
+    maybePosixTime <- extractField $ lookup (typeRep @"posixTime") richMsgMap
     pure $ formatter maybeThreadId maybePosixTime richMsgMsg
 
 {- | Shows time in the following format:

@@ -28,8 +28,8 @@ import Colog (HasLog (..), LogAction, Message, Msg (..), PureLogger, RichMsg (..
               logWarning, pattern D, runPureLog, upgradeMessageAction, usingLoggerT, withLog,
               withLogTextFile, (*<), (<&), (>$), (>$<), (>*), (>*<), (>|<))
 
-import qualified Data.TypeRepMap as TM
-
+import Data.Dependent.Map (delete)
+import Type.Reflection (typeRep)
 
 example :: WithLog env Message m => m ()
 example = do
@@ -188,7 +188,7 @@ main = withLogTextFile "tutorials/example.log" $ \logTextFile -> do
 
     let fullMessageAction = upgradeMessageAction defaultFieldMap richMessageAction
     let semiMessageAction = upgradeMessageAction
-                                (TM.delete @"threadId" defaultFieldMap)
+                                (delete (typeRep @"threadId") defaultFieldMap)
                                 richMessageAction
 
     runApp simpleMessageAction