{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

{- ORMOLU_DISABLE -}

-- | Provides a static terminal effect.
--
-- @since 0.1
module Effectful.Terminal.Static
  ( -- * 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.ByteString qualified as BS
import Data.Text (Text)
import Data.Text qualified as T
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    unsafeEff_,
  )
import Effectful.Exception (throwIO)
import GHC.IO.Exception
  ( IOErrorType (SystemError),
    IOException
      ( IOError,
        ioe_description,
        ioe_errno,
        ioe_filename,
        ioe_handle,
        ioe_location,
        ioe_type
      ),
  )
import System.Console.Pretty qualified as CPretty
import System.Console.Terminal.Size (Window (Window, height, width), size)
import System.IO qualified as IO
import Prelude
  ( Applicative (pure),
    Bool,
    Char,
    Integral,
    Maybe (Just, Nothing),
    Monad ((>>=)),
    Show (show),
    String,
    ($),
    (.),
    (<$>),
  )

-- | Static terminal effect.
--
-- @since 0.1
data Terminal :: Effect

type instance DispatchOf Terminal = Static WithSideEffects

data instance StaticRep Terminal = MkTerminal

-- | Runs 'Terminal' in 'Prelude.IO'.
--
-- @since 0.1
runTerminal :: (HasCallStack, IOE :> es) => Eff (Terminal : es) a -> Eff es a
runTerminal :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (Terminal : es) a -> Eff es a
runTerminal = StaticRep Terminal -> Eff (Terminal : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Terminal
MkTerminal

-- | Lifted 'IO.putStr'.
--
-- @since 0.1
putStr :: (HasCallStack, Terminal :> es) => String -> Eff es ()
putStr :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStr = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (String -> IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
IO.putStr

-- | Lifted 'IO.putStrLn'.
--
-- @since 0.1
putStrLn :: (HasCallStack, Terminal :> es) => String -> Eff es ()
putStrLn :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
String -> Eff es ()
putStrLn = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (String -> IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
IO.putStrLn

-- | Lifted 'BS.putStr'.
--
-- @since 0.1
putBinary :: (HasCallStack, Terminal :> es) => ByteString -> Eff es ()
putBinary :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
ByteString -> Eff es ()
putBinary = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (ByteString -> IO ()) -> ByteString -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
BS.putStr

-- | Lifted 'IO.getChar'.
--
-- @since 0.1
getChar :: (HasCallStack, Terminal :> es) => Eff es Char
getChar :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
Eff es Char
getChar = IO Char -> Eff es Char
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO Char
IO.getChar

-- | Lifted 'IO.getLine'.
--
-- @since 0.1
getLine :: (HasCallStack, Terminal :> es) => Eff es String
getLine :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
Eff es String
getLine = IO String -> Eff es String
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO String
IO.getLine

#if MIN_VERSION_base(4,15,0)

-- | Lifted 'IO.getContents''.
--
-- @since 0.1
getContents' :: (HasCallStack, Terminal :> es) => Eff es String
getContents' :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
Eff es String
getContents' = IO String -> Eff es String
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO String
IO.getContents'

#endif

-- | Retrieves the terminal size.
--
-- @since 0.1
getTerminalSize ::
  ( HasCallStack,
    Integral a,
    Terminal :> es
  ) =>
  Eff es (Window a)
getTerminalSize :: forall a (es :: [Effect]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es (Window a)
getTerminalSize =
  IO (Maybe (Window a)) -> Eff es (Maybe (Window a))
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO (Maybe (Window a))
forall n. Integral n => IO (Maybe (Window n))
size Eff es (Maybe (Window a))
-> (Maybe (Window a) -> Eff es (Window a)) -> Eff es (Window a)
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Window a
h -> Window a -> Eff es (Window a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Window a
h
    Maybe (Window a)
Nothing ->
      IOException -> Eff es (Window a)
forall e (es :: [Effect]) a.
(HasCallStack, Exception e) =>
e -> Eff es a
throwIO (IOException -> Eff es (Window a))
-> IOException -> Eff es (Window a)
forall a b. (a -> b) -> a -> b
$
        IOError
          { ioe_handle :: Maybe Handle
ioe_handle = Maybe Handle
forall a. Maybe a
Nothing,
            ioe_type :: IOErrorType
ioe_type = IOErrorType
SystemError,
            ioe_location :: String
ioe_location = String
"getTerminalSize",
            ioe_description :: String
ioe_description = String
"Failed to detect the terminal size",
            ioe_errno :: Maybe CInt
ioe_errno = Maybe CInt
forall a. Maybe a
Nothing,
            ioe_filename :: Maybe String
ioe_filename = Maybe String
forall a. Maybe a
Nothing
          }

-- | Determines if we support ANSI styling.
--
-- @since 0.1
supportsPretty :: (HasCallStack, Terminal :> es) => Eff es Bool
supportsPretty :: forall (es :: [Effect]).
(HasCallStack, Terminal :> es) =>
Eff es Bool
supportsPretty = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO Bool
CPretty.supportsPretty

-- | @since 0.1
print :: (Show a, HasCallStack, Terminal :> es) => a -> Eff es ()
print :: forall a (es :: [Effect]).
(Show a, HasCallStack, Terminal :> es) =>
a -> Eff es ()
print = String -> Eff es ()
forall (es :: [Effect]).
(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 :: [Effect]).
(HasCallStack, Terminal :> es) =>
Text -> Eff es ()
putText = String -> Eff es ()
forall (es :: [Effect]).
(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 :: [Effect]).
(HasCallStack, Terminal :> es) =>
Text -> Eff es ()
putTextLn = String -> Eff es ()
forall (es :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(HasCallStack, Integral a, Terminal :> es) =>
Eff es (Window a)
getTerminalSize