module Ribosome.App.UserInput where

import qualified Data.Text.IO as Text
import Path (Path)
import Rainbow (
  Chunk,
  Radiant,
  blue,
  bold,
  chunk,
  color256,
  faint,
  fore,
  green,
  hPutChunks,
  hPutChunksLn,
  magenta,
  only256,
  yellow,
  )
import System.IO (getLine, stderr)

import Ribosome.App.Error (RainbowError, appError, outputError)
import Ribosome.Host.Path (pathText)

color :: Radiant -> Word8 -> Chunk -> Chunk
color :: Radiant -> Word8 -> Chunk -> Chunk
color Radiant
r Word8
c =
  Radiant -> Chunk -> Chunk
fore (Radiant
r Radiant -> Radiant -> Radiant
forall a. Semigroup a => a -> a -> a
<> Radiant -> Radiant
only256 (Word8 -> Radiant
color256 Word8
c))

fbColor :: Radiant -> Word8 -> Chunk -> Chunk
fbColor :: Radiant -> Word8 -> Chunk -> Chunk
fbColor Radiant
r Word8
c =
  Radiant -> Word8 -> Chunk -> Chunk
color Radiant
r Word8
c (Chunk -> Chunk) -> (Chunk -> Chunk) -> Chunk -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Chunk
faint (Chunk -> Chunk) -> (Chunk -> Chunk) -> Chunk -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Chunk
bold

pathColor :: Chunk -> Chunk
pathColor :: Chunk -> Chunk
pathColor =
  Radiant -> Word8 -> Chunk -> Chunk
fbColor Radiant
yellow Word8
172

cmdColor :: Chunk -> Chunk
cmdColor :: Chunk -> Chunk
cmdColor =
  Radiant -> Word8 -> Chunk -> Chunk
fbColor Radiant
blue Word8
111

pathChunk :: Path b t -> Chunk
pathChunk :: forall b t. Path b t -> Chunk
pathChunk Path b t
path =
  Chunk -> Chunk
pathColor (Text -> Chunk
chunk (Path b t -> Text
forall b t. Path b t -> Text
pathText Path b t
path))

neovimChunk :: Chunk
neovimChunk :: Chunk
neovimChunk =
  Radiant -> Word8 -> Chunk -> Chunk
fbColor Radiant
green Word8
76 Chunk
"Neovim"

linkChunk :: Text -> Chunk
linkChunk :: Text -> Chunk
linkChunk =
  Radiant -> Word8 -> Chunk -> Chunk
fbColor Radiant
blue Word8
33 (Chunk -> Chunk) -> (Text -> Chunk) -> Text -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk

putStderr ::
  Member (Embed IO) r =>
  Text ->
  Sem r ()
putStderr :: forall (r :: EffectRow). Member (Embed IO) r => Text -> Sem r ()
putStderr =
  IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> (Text -> IO ()) -> Text -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr

infoMessage ::
  Members [Stop RainbowError, Embed IO] r =>
  [Chunk] ->
  Sem r ()
infoMessage :: forall (r :: EffectRow).
Members '[Stop RainbowError, Embed IO] r =>
[Chunk] -> Sem r ()
infoMessage [Chunk]
cs =
  IO () -> Sem r ()
forall (r :: EffectRow) a.
Members '[Stop RainbowError, Embed IO] r =>
IO a -> Sem r a
outputError (Handle -> [Chunk] -> IO ()
hPutChunksLn Handle
stderr (Radiant -> Word8 -> Chunk -> Chunk
color Radiant
magenta Word8
55 (Chunk -> Chunk
bold Chunk
">>= ") Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
cs))

askUser ::
  Eq a =>
  IsString a =>
  Members [Stop RainbowError, Embed IO] r =>
  Text ->
  Sem r (Maybe a)
askUser :: forall a (r :: EffectRow).
(Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) =>
Text -> Sem r (Maybe a)
askUser Text
msg = do
  [Chunk] -> Sem r ()
forall (r :: EffectRow).
Members '[Stop RainbowError, Embed IO] r =>
[Chunk] -> Sem r ()
infoMessage [Radiant -> Chunk -> Chunk
fore Radiant
blue (Text -> Chunk
chunk Text
msg)]
  IO () -> Sem r ()
forall (r :: EffectRow) a.
Members '[Stop RainbowError, Embed IO] r =>
IO a -> Sem r a
outputError (Handle -> [Chunk] -> IO ()
hPutChunks Handle
stderr [Item [Chunk]
"✍️", Radiant -> Chunk -> Chunk
fore Radiant
magenta (Chunk -> Chunk
bold Chunk
" > ")])
  a -> Maybe a
check (a -> Maybe a) -> (String -> a) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString (String -> Maybe a) -> Sem r String -> Sem r (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> RainbowError) -> IO String -> Sem r String
forall e (r :: EffectRow) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryIOError (RainbowError -> Text -> RainbowError
forall a b. a -> b -> a
const (RainbowError
"" RainbowError -> RainbowError -> RainbowError
forall a. Semigroup a => a -> a -> a
<> [Chunk] -> RainbowError
appError [Item [Chunk]
"Aborted."])) IO String
getLine
  where
    check :: a -> Maybe a
check = \case
      a
"" -> Maybe a
forall a. Maybe a
Nothing
      a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a

askRequired ::
  Eq a =>
  IsString a =>
  Members [Stop RainbowError, Embed IO] r =>
  Text ->
  Sem r a
askRequired :: forall a (r :: EffectRow).
(Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) =>
Text -> Sem r a
askRequired Text
msg =
  Text -> Sem r (Maybe a)
forall a (r :: EffectRow).
(Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) =>
Text -> Sem r (Maybe a)
askUser Text
msg Sem r (Maybe a) -> (Maybe a -> Sem r a) -> Sem r a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just a
a -> a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Maybe a
Nothing -> do
      [Chunk] -> Sem r ()
forall (r :: EffectRow).
Members '[Stop RainbowError, Embed IO] r =>
[Chunk] -> Sem r ()
infoMessage [Radiant -> Chunk -> Chunk
fore Radiant
magenta (Chunk -> Chunk
faint Chunk
"This option is mandatory.")]
      Text -> Sem r a
forall a (r :: EffectRow).
(Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) =>
Text -> Sem r a
askRequired Text
msg