{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}

{- ORMOLU_DISABLE -}

-- | Provides a dynamic terminal effect.
--
-- @since 0.1
module Effectful.Terminal.Dynamic
  ( -- * Effect
    Terminal (..),
    putStr,
    putStrLn,
    putBinary,
    getChar,
    getLine,
#if MIN_VERSION_base(4,15,0)
    getContents',
#endif
    getTerminalSize,
    supportsPretty,

    -- ** Handlers
    runTerminal,

    -- * Functions
    print,

    -- * Text
    putText,
    putTextLn,
    getTextLine,
#if MIN_VERSION_base(4,15,0)
    getTextContents',
#endif

    -- * Window
    getTerminalWidth,
    getTerminalHeight,

    -- * Re-exports
    Window (..),
    Text,
  )
where

{- ORMOLU_ENABLE -}

import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Text qualified as T
import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Dynamic (HasCallStack, reinterpret_, send)
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.Terminal.Static qualified as Static
import System.Console.Terminal.Size (Window (Window, height, width))
import Prelude
  ( Bool,
    Char,
    Integral,
    Show (show),
    String,
    ($),
    (.),
    (<$>),
  )

{- ORMOLU_DISABLE -}

-- | Dynamic terminal effect.
--
-- @since 0.1
data Terminal :: Effect where
  PutStr :: String -> Terminal m ()
  PutStrLn :: String -> Terminal m ()
  PutBinary :: ByteString -> Terminal m ()
  GetChar :: Terminal m Char
  GetLine :: Terminal m String
#if MIN_VERSION_base(4,15,0)
  GetContents' :: Terminal m String
#endif
  GetTerminalSize :: Integral a => Terminal m (Window a)
  SupportsPretty :: Terminal m Bool


-- | @since 0.1
instance ShowEffect Terminal where
  showEffectCons :: forall (m :: * -> *) a. Terminal m a -> String
showEffectCons = \case
    PutStr String
_ -> String
"PutStr"
    PutStrLn String
_ -> String
"PutStrLn"
    PutBinary ByteString
_ -> String
"PutBinary"
    Terminal m a
GetChar -> String
"GetChar"
    Terminal m a
GetLine -> String
"GetLine"
#if MIN_VERSION_base(4,15,0)
    Terminal m a
GetContents' -> String
"GetContents'"
#endif
    Terminal m a
GetTerminalSize -> String
"GetTerminalSize"
    Terminal m a
SupportsPretty -> String
"SupportsPretty"

-- | @since 0.1
type instance DispatchOf Terminal = Dynamic

-- | Runs 'Terminal' in 'Prelude.IO'.
--
-- @since 0.1
runTerminal :: (HasCallStack, IOE :> es) => Eff (Terminal : es) a -> Eff es a
runTerminal :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Terminal : es) a -> Eff es a
runTerminal = (Eff (Terminal : es) a -> Eff es a)
-> EffectHandler_ Terminal (Terminal : es)
-> Eff (Terminal : es) a
-> Eff es a
forall (e :: (* -> *) -> * -> *)
       (handlerEs :: [(* -> *) -> * -> *]) a (es :: [(* -> *) -> * -> *])
       b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler_ e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret_ Eff (Terminal : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Terminal : es) a -> Eff es a
Static.runTerminal (EffectHandler_ Terminal (Terminal : es)
 -> Eff (Terminal : es) a -> Eff es a)
-> EffectHandler_ Terminal (Terminal : es)
-> Eff (Terminal : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \case
  PutStr String
s -> String -> Eff (Terminal : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
Static.putStr String
s
  PutStrLn String
s -> String -> Eff (Terminal : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
Static.putStrLn String
s
  PutBinary ByteString
s -> ByteString -> Eff (Terminal : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
ByteString -> Eff es ()
Static.putBinary ByteString
s
  Terminal (Eff localEs) a
GetChar -> Eff (Terminal : es) a
Eff (Terminal : es) Char
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es Char
Static.getChar
  Terminal (Eff localEs) a
GetLine -> Eff (Terminal : es) a
Eff (Terminal : es) String
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es String
Static.getLine
#if MIN_VERSION_base(4,15,0)
  Terminal (Eff localEs) a
GetContents' -> Eff (Terminal : es) a
Eff (Terminal : es) String
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es String
Static.getContents'
#endif
  Terminal (Eff localEs) a
GetTerminalSize -> Eff (Terminal : es) a
Eff (Terminal : es) (Window a)
forall a (es :: [(* -> *) -> * -> *]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es (Window a)
Static.getTerminalSize
  Terminal (Eff localEs) a
SupportsPretty -> Eff (Terminal : es) a
Eff (Terminal : es) Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es Bool
Static.supportsPretty

{- ORMOLU_ENABLE -}

-- | Lifted 'IO.putStr'.
--
-- @since 0.1
putStr :: (HasCallStack, Terminal :> es) => String -> Eff es ()
putStr :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStr = Terminal (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Terminal (Eff es) () -> Eff es ())
-> (String -> Terminal (Eff es) ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Terminal (Eff es) ()
forall (m :: * -> *). String -> Terminal m ()
PutStr

-- | Lifted 'IO.putStrLn'.
--
-- @since 0.1
putStrLn :: (HasCallStack, Terminal :> es) => String -> Eff es ()
putStrLn :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStrLn = Terminal (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Terminal (Eff es) () -> Eff es ())
-> (String -> Terminal (Eff es) ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Terminal (Eff es) ()
forall (m :: * -> *). String -> Terminal m ()
PutStrLn

-- | Lifted 'BS.putStr'.
--
-- @since 0.1
putBinary :: (HasCallStack, Terminal :> es) => ByteString -> Eff es ()
putBinary :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
ByteString -> Eff es ()
putBinary = Terminal (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Terminal (Eff es) () -> Eff es ())
-> (ByteString -> Terminal (Eff es) ()) -> ByteString -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Terminal (Eff es) ()
forall (m :: * -> *). ByteString -> Terminal m ()
PutBinary

-- | Lifted 'IO.getChar'.
--
-- @since 0.1
getChar :: (HasCallStack, Terminal :> es) => Eff es Char
getChar :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es Char
getChar = Terminal (Eff es) Char -> Eff es Char
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Terminal (Eff es) Char
forall (m :: * -> *). Terminal m Char
GetChar

-- | Lifted 'IO.getLine'.
--
-- @since 0.1
getLine :: (HasCallStack, Terminal :> es) => Eff es String
getLine :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es String
getLine = Terminal (Eff es) String -> Eff es String
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Terminal (Eff es) String
forall (m :: * -> *). Terminal m String
GetLine

#if MIN_VERSION_base(4,15,0)

-- | Lifted 'IO.getContents''.
--
-- @since 0.1
getContents' :: (HasCallStack, Terminal :> es) => Eff es String
getContents' :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es String
getContents' = Terminal (Eff es) String -> Eff es String
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Terminal (Eff es) String
forall (m :: * -> *). Terminal m String
GetContents'

#endif

-- | Retrieves the terminal size.
--
-- @since 0.1
getTerminalSize ::
  ( HasCallStack,
    Integral a,
    Terminal :> es
  ) =>
  Eff es (Window a)
getTerminalSize :: forall a (es :: [(* -> *) -> * -> *]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es (Window a)
getTerminalSize = Terminal (Eff es) (Window a) -> Eff es (Window a)
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Terminal (Eff es) (Window a)
forall a (m :: * -> *). Integral a => Terminal m (Window a)
GetTerminalSize

-- | Determines if we support ANSI styling.
--
-- @since 0.1
supportsPretty :: (HasCallStack, Terminal :> es) => Eff es Bool
supportsPretty :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es Bool
supportsPretty = Terminal (Eff es) Bool -> Eff es Bool
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Terminal (Eff es) Bool
forall (m :: * -> *). Terminal m Bool
SupportsPretty

-- | @since 0.1
print :: (Show a, HasCallStack, Terminal :> es) => a -> Eff es ()
print :: forall a (es :: [(* -> *) -> * -> *]).
(Show a, HasCallStack, Terminal :> es) =>
a -> Eff es ()
print = String -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStrLn (String -> Eff es ()) -> (a -> String) -> a -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | 'Text' version of 'putStr'.
--
-- @since 0.1
putText :: (HasCallStack, Terminal :> es) => Text -> Eff es ()
putText :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Text -> Eff es ()
putText = String -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStr (String -> Eff es ()) -> (Text -> String) -> Text -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | 'Text' version of 'putStrLn'.
--
-- @since 0.1
putTextLn :: (HasCallStack, Terminal :> es) => Text -> Eff es ()
putTextLn :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Text -> Eff es ()
putTextLn = String -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStrLn (String -> Eff es ()) -> (Text -> String) -> Text -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | @since 0.1
getTextLine :: (HasCallStack, Terminal :> es) => Eff es Text
getTextLine :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es Text
getTextLine = String -> Text
T.pack (String -> Text) -> Eff es String -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es String
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es String
getLine

#if MIN_VERSION_base(4,15,0)

-- | @since 0.1
getTextContents' :: (HasCallStack, Terminal :> es) => Eff es Text
getTextContents' :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es Text
getTextContents' = String -> Text
T.pack (String -> Text) -> Eff es String -> Eff es Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es String
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Terminal :> es) =>
Eff es String
getContents'

#endif

-- | Retrieves the terminal width.
--
-- @since 0.1
getTerminalWidth :: (HasCallStack, Integral a, Terminal :> es) => Eff es a
getTerminalWidth :: forall a (es :: [(* -> *) -> * -> *]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es a
getTerminalWidth = Window a -> a
forall a. Window a -> a
width (Window a -> a) -> Eff es (Window a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es (Window a)
forall a (es :: [(* -> *) -> * -> *]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es (Window a)
getTerminalSize

-- | Retrieves the terminal height.
--
-- @since 0.1
getTerminalHeight :: (HasCallStack, Integral a, Terminal :> es) => Eff es a
getTerminalHeight :: forall a (es :: [(* -> *) -> * -> *]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es a
getTerminalHeight = Window a -> a
forall a. Window a -> a
height (Window a -> a) -> Eff es (Window a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es (Window a)
forall a (es :: [(* -> *) -> * -> *]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es (Window a)
getTerminalSize