55 lines
1.5 KiB
Haskell
55 lines
1.5 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
|