{-# LANGUAGE QuasiQuotes #-}

module Hinit.Cli where

import Control.Effect.Lift
import Control.Effect.Terminal
import Control.Effect.Throw
import Data.Maybe
import Data.String.Interpolate
import Data.Text (Text, unpack)
import Hinit.Errors
import Hinit.Template
import Hinit.Types
import Hinit.Utils
import Path
import Prettyprinter
import Prettyprinter.Render.Terminal
import System.IO

query :: Has Terminal sig m => ValType -> Text -> Maybe Text -> m Val
query :: ValType -> Text -> Maybe Text -> m Val
query ValType
ty Text
name Maybe Text
desc = do
  Handle -> Doc AnsiStyle -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
Handle -> Doc AnsiStyle -> m ()
prettyPrint Handle
stdout Doc AnsiStyle
info
  ValType -> m Val
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
ValType -> m Val
query' ValType
ty
  where
    info :: Doc AnsiStyle
    info :: Doc AnsiStyle
info =
      [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
        [ Doc AnsiStyle
"Please input the value of option",
          Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
              Doc AnsiStyle -> [Doc AnsiStyle]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Cyan AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> AnsiStyle
underlined) [i|#{name} : #{ty}|])
                [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. [a] -> [a] -> [a]
++ (Text -> Doc AnsiStyle) -> [Text] -> [Doc AnsiStyle]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle -> Doc AnsiStyle)
-> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty) (Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
desc)
        ]

query' :: Has Terminal sig m => ValType -> m Val
query' :: ValType -> m Val
query' ValType
ty = do
  Maybe Text
resp <- String -> m (Maybe Text)
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
String -> m (Maybe Text)
prompt String
"(y/n)> "
  case Maybe Text
resp of
    Maybe Text
Nothing -> ValType -> m Val
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
ValType -> m Val
query' ValType
ty
    Just Text
r ->
      case ValType
ty of
        ValType
Text' -> Val -> m Val
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
Text Text
r
        ValType
Bool' ->
          case Text -> Maybe Bool
readYesNo Text
r of
            Maybe Bool
Nothing -> do
              Handle -> Doc AnsiStyle -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
Handle -> Doc AnsiStyle -> m ()
prettyPrint Handle
stderr (Doc AnsiStyle -> m ()) -> Doc AnsiStyle -> m ()
forall a b. (a -> b) -> a -> b
$ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) [i|Please type "y" or "n"|]
              ValType -> m Val
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
ValType -> m Val
query' ValType
ty
            Just Bool
b -> Val -> m Val
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
Bool Bool
b

parseProject :: Has (Throw IllformedPath) sig m => Text -> m (Path Rel Dir)
parseProject :: Text -> m (Path Rel Dir)
parseProject Text
project =
  let err :: IllformedPath
err = Text -> IllformedPath
ProjectName Text
project
   in case String -> Maybe (Path Rel Dir)
forall (m :: Type -> Type).
MonadThrow m =>
String -> m (Path Rel Dir)
parseRelDir (Text -> String
unpack Text
project) of
        Maybe (Path Rel Dir)
Nothing -> IllformedPath -> m (Path Rel Dir)
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError IllformedPath
err
        Just Path Rel Dir
dir
          | Bool -> Bool
not (Path Rel Dir -> Bool
forall a. Path Rel a -> Bool
underCurrentDir Path Rel Dir
dir) -> IllformedPath -> m (Path Rel Dir)
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError IllformedPath
err
          | Bool
otherwise -> Path Rel Dir -> m (Path Rel Dir)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Path Rel Dir
dir