{-# LANGUAGE AllowAmbiguousTypes #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024-2025 Sayo contributors
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Interpreters for the [@co-log@](https://hackage.haskell.org/package/co-log) ecosystem.

The interface is similar to [@co-log-polysemy@](https://hackage.haskell.org/package/co-log-polysemy).
-}
module Data.Effect.Log where

import Colog.Core (LogAction (LogAction))
import Control.Effect (emb)
import Data.Effect (Emb)
import Data.Effect.Output (Output (Output), output)
import Prelude hiding (log)

data Log msg :: Effect where
    Log :: msg -> Log msg f ()
makeEffectF ''Log

runLogAsOutput :: forall msg a es ff c. (Output msg :> es, Free c ff) => Eff ff (Log msg ': es) a -> Eff ff es a
runLogAsOutput :: forall msg a (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Output msg :> es, Free c ff) =>
Eff ff (Log msg : es) a -> Eff ff es a
runLogAsOutput = (Log msg ~~> Eff ff es) -> Eff ff (Log msg : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \(Log msg
msg) -> msg -> Eff ff es ()
forall o (f :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output msg
msg
{-# INLINE runLogAsOutput #-}

runOutputAsLog :: forall msg a es ff c. (Log msg :> es, Free c ff) => Eff ff (Output msg ': es) a -> Eff ff es a
runOutputAsLog :: forall msg a (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Log msg :> es, Free c ff) =>
Eff ff (Output msg : es) a -> Eff ff es a
runOutputAsLog = (Output msg ~~> Eff ff es)
-> Eff ff (Output msg : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \(Output msg
msg) -> msg -> Eff ff es ()
forall msg (f :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Log msg :> es) =>
msg -> f ()
log msg
msg
{-# INLINE runOutputAsLog #-}

runLogAction :: forall msg a es ff c. (Free c ff) => LogAction (Eff ff es) msg -> Eff ff (Log msg ': es) a -> Eff ff es a
runLogAction :: forall msg a (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
Free c ff =>
LogAction (Eff ff es) msg -> Eff ff (Log msg : es) a -> Eff ff es a
runLogAction (LogAction msg -> Eff ff es ()
f) = (Log msg ~~> Eff ff es) -> Eff ff (Log msg : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \(Log msg
msg) -> msg -> Eff ff es ()
f msg
msg
{-# INLINE runLogAction #-}

runLogActionEmbed :: forall msg f a es ff c. (Emb f :> es, Free c ff) => LogAction f msg -> Eff ff (Log msg ': es) a -> Eff ff es a
runLogActionEmbed :: forall msg (f :: * -> *) a (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Emb f :> es, Free c ff) =>
LogAction f msg -> Eff ff (Log msg : es) a -> Eff ff es a
runLogActionEmbed (LogAction msg -> f ()
f) = (Log msg ~~> Eff ff es) -> Eff ff (Log msg : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \(Log msg
msg) -> f () -> Eff ff es ()
forall (f :: * -> *) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Emb f :> es, Free c ff) =>
f a -> Eff ff es a
emb (f () -> Eff ff es ()) -> f () -> Eff ff es ()
forall a b. (a -> b) -> a -> b
$ msg -> f ()
f msg
msg
{-# INLINE runLogActionEmbed #-}