{-# LANGUAGE TemplateHaskell #-}

module Polysemy.Sgr (
  Sgr
  , sgr
  , runSgrToOutput
  , ignoreSgr
  , SgrRegion
  , withSgr
  , SgrFull
  , runSgrFull
  , ignoreSgrFull
) where

import Relude hiding (Reader, ask, asks, local, runReader)

import Data.Text (pack)
import Polysemy (Effect, Member, Members, Sem, interpret, makeSem)
import Polysemy.Output (Output, output)
import Polysemy.Reader (Reader, ask, asks, local, runReader)
import System.Console.ANSI qualified as ANSI

data Sgr :: Effect where
  Sgr :: [ANSI.SGR] -> Sgr r ()

$(makeSem ''Sgr)

runSgrToOutput ::
  Member (Output Text) r =>
  Sem (Sgr : r) a ->
  Sem r a
runSgrToOutput = interpret \(Sgr cs) -> output $ pack $ ANSI.setSGRCode cs

ignoreSgr :: Sem (Sgr : r) a -> Sem r a
ignoreSgr = interpret \(Sgr _) -> pass

type SgrRegion :: Effect
type SgrRegion = Reader [ANSI.SGR]

withSgr ::
  Members [SgrRegion, Sgr] r =>
  [ANSI.SGR] ->
  Sem r a ->
  Sem r a
withSgr es act = do
  asks (++ es) >>= sgr
  result <- local (++ es) act
  ask >>= sgr
  pure result

runSgrRegion :: Sem (SgrRegion : r) a -> Sem r a
runSgrRegion = runReader [ANSI.Reset]

type SgrFull :: [Effect]
type SgrFull = [SgrRegion, Sgr]

runSgrFull ::
  Member (Output Text) r =>
  Sem (SgrRegion : Sgr : r) a ->
  Sem r a
runSgrFull = runSgrToOutput . runSgrRegion

ignoreSgrFull :: Sem (SgrRegion : Sgr : r) a -> Sem r a
ignoreSgrFull = ignoreSgr . runSgrRegion