65 lines
1.4 KiB
Haskell
65 lines
1.4 KiB
Haskell
{-# 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
|