diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 9d7b29e..cb9b3e7 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.17.20231010 +# version: 0.19.20240514 # -# REGENDATA ("0.17.20231010",["github","--config=cabal.haskell-ci","cabal.project"]) +# REGENDATA ("0.19.20240514",["github","--config=cabal.haskell-ci","cabal.project"]) # name: Haskell-CI on: @@ -27,24 +27,29 @@ jobs: timeout-minutes: 60 container: - image: buildpack-deps:bionic + image: buildpack-deps:jammy continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.8.1 + - compiler: ghc-9.10.1 compilerKind: ghc - compilerVersion: 9.8.1 + compilerVersion: 9.10.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.6.3 + - compiler: ghc-9.8.2 compilerKind: ghc - compilerVersion: 9.6.3 + compilerVersion: 9.8.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.7 + - compiler: ghc-9.6.5 compilerKind: ghc - compilerVersion: 9.4.7 + compilerVersion: 9.6.5 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.4.8 + compilerKind: ghc + compilerVersion: 9.4.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.2.8 @@ -62,32 +67,17 @@ jobs: compilerVersion: 8.10.7 setup-method: ghcup allow-failure: false - - compiler: ghc-8.8.4 - compilerKind: ghc - compilerVersion: 8.8.4 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 - if [ "${{ matrix.setup-method }}" = ghcup ]; then - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - else - apt-add-repository -y 'ppa:hvr/ghc' - apt-get update - apt-get install -y "$HCNAME" - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - fi + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -99,22 +89,13 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - if [ "${{ matrix.setup-method }}" = ghcup ]; then - 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" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - else - HC=$HCDIR/bin/$HCKIND - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" - echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - fi - + 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" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" @@ -162,9 +143,9 @@ jobs: run: | $CABAL v2-update -v - name: cache (tools) - uses: actions/cache/restore@v3 + uses: actions/cache/restore@v4 with: - key: ${{ runner.os }}-${{ matrix.compiler }}-tools-0f8d33a5 + key: ${{ runner.os }}-${{ matrix.compiler }}-tools-655fd156 path: ~/.haskell-ci-tools - name: install cabal-plan run: | @@ -177,16 +158,16 @@ jobs: cabal-plan --version - name: install doctest run: | - $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.22' - doctest --version + if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.22.0' ; fi + if [ $((HCNUMVER < 91000)) -ne 0 ] ; then doctest --version ; fi - name: save cache (tools) - uses: actions/cache/save@v3 + uses: actions/cache/save@v4 if: always() with: - key: ${{ runner.os }}-${{ matrix.compiler }}-tools-0f8d33a5 + key: ${{ runner.os }}-${{ matrix.compiler }}-tools-655fd156 path: ~/.haskell-ci-tools - name: checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: source - name: initial cabal.project for sdist @@ -214,7 +195,7 @@ jobs: echo " ghc-options: -Werror=missing-methods" >> cabal.project cat >> cabal.project <> cabal.project.local + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(log-effectful)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local - name: dump install plan @@ -222,7 +203,7 @@ jobs: $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - name: restore cache - uses: actions/cache/restore@v3 + uses: actions/cache/restore@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -242,8 +223,8 @@ jobs: $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct - name: doctest run: | - cd ${PKGDIR_log_effectful} || false - doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src + if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cd ${PKGDIR_log_effectful} || false ; fi + if [ $((HCNUMVER < 91000)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi - name: cabal check run: | cd ${PKGDIR_log_effectful} || false @@ -256,7 +237,7 @@ jobs: rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - name: save cache - uses: actions/cache/save@v3 + uses: actions/cache/save@v4 if: always() with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} diff --git a/CHANGELOG.md b/CHANGELOG.md index 0d97392..f08fa16 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,2 +1,5 @@ +# log-effectful-1.0.1.0 (2024-??-??) +* Convert `Log` into a dynamically dispatched effect. + # log-effectful-1.0.0.0 (2022-10-10) * Initial release. diff --git a/log-effectful.cabal b/log-effectful.cabal index 87475d7..d9e5f8a 100644 --- a/log-effectful.cabal +++ b/log-effectful.cabal @@ -1,7 +1,7 @@ -cabal-version: 2.4 +cabal-version: 3.0 build-type: Simple name: log-effectful -version: 1.0.0.0 +version: 1.0.1.0 license: BSD-3-Clause license-file: LICENSE category: System @@ -16,8 +16,7 @@ extra-source-files: CHANGELOG.md README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3 - || ==9.8.1 +tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.5, 9.8.2, 9.10.1 } bug-reports: https://github.com/haskell-effectful/log-effectful/issues source-repository head @@ -55,6 +54,7 @@ library import: language build-depends: base <5 + , aeson >=2.0.0.0 , effectful-core >=1.0.0.0 && <3.0.0.0 , log-base >=0.12.0.0 , text diff --git a/src/Effectful/Log.hs b/src/Effectful/Log.hs index beba270..ee4d755 100644 --- a/src/Effectful/Log.hs +++ b/src/Effectful/Log.hs @@ -3,7 +3,7 @@ -- | Logging via 'MonadLog'. module Effectful.Log ( -- * Effect - Log + Log (..) -- ** Handlers , runLog @@ -12,17 +12,23 @@ module Effectful.Log , module Log ) where +import Data.Aeson.Types import Data.Text (Text) import Data.Time.Clock -import Effectful.Dispatch.Static +import Effectful.Dispatch.Dynamic +import Effectful.Reader.Static import Effectful import Log -- | Provide the ability to log messages via 'MonadLog'. -data Log :: Effect +data Log :: Effect where + LogMessageOp :: LogLevel -> Text -> Value -> Log m () + LocalData :: [Pair] -> m a -> Log m a + LocalDomain :: Text -> m a -> Log m a + LocalMaxLogLevel :: LogLevel -> m a -> Log m a + GetLoggerEnv :: Log m LoggerEnv -type instance DispatchOf Log = Static WithSideEffects -newtype instance StaticRep Log = Log LoggerEnv +type instance DispatchOf Log = Dynamic -- | Run the 'Log' effect. -- @@ -38,30 +44,31 @@ runLog -> Eff (Log : es) a -- ^ The computation to run. -> Eff es a -runLog component logger maxLogLevel = evalStaticRep $ Log LoggerEnv - { leLogger = logger - , leComponent = component - , leDomain = [] - , leData = [] - , leMaxLogLevel = maxLogLevel - } +runLog component logger maxLogLevel = reinterpret reader $ \env -> \case + LogMessageOp level message data_ -> do + time <- liftIO getCurrentTime + logEnv <- ask + liftIO $ logMessageIO logEnv time level message data_ + LocalData data_ action -> localSeqUnlift env $ \unlift -> do + (`local` unlift action) $ \logEnv -> logEnv { leData = data_ ++ leData logEnv } + LocalDomain domain action -> localSeqUnlift env $ \unlift -> do + (`local` unlift action) $ \logEnv -> logEnv { leDomain = leDomain logEnv ++ [domain] } + LocalMaxLogLevel level action -> localSeqUnlift env $ \unlift -> do + (`local` unlift action) $ \logEnv -> logEnv { leMaxLogLevel = level } + GetLoggerEnv -> ask + where + reader = runReader LoggerEnv + { leLogger = logger + , leComponent = component + , leDomain = [] + , leData = [] + , leMaxLogLevel = maxLogLevel + } -- | Orphan, canonical instance. instance Log :> es => MonadLog (Eff es) where - logMessage level message data_ = do - time <- unsafeEff_ getCurrentTime - Log logEnv <- getStaticRep - unsafeEff_ $ logMessageIO logEnv time level message data_ - - localData data_ = localStaticRep $ \(Log logEnv) -> - Log logEnv { leData = data_ ++ leData logEnv } - - localDomain domain = localStaticRep $ \(Log logEnv) -> - Log logEnv { leDomain = leDomain logEnv ++ [domain] } - - localMaxLogLevel level = localStaticRep $ \(Log logEnv) -> - Log logEnv { leMaxLogLevel = level } - - getLoggerEnv = do - Log env <- getStaticRep - pure env + logMessage level message data_ = send $ LogMessageOp level message data_ + localData data_ action = send $ LocalData data_ action + localDomain domain action = send $ LocalDomain domain action + localMaxLogLevel level action = send $ LocalMaxLogLevel level action + getLoggerEnv = send GetLoggerEnv