{-# 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