From: b3nj4m1n Date: Fri, 20 May 2022 21:34:05 +0000 (+0200) Subject: Separate prompts X-Git-Tag: v0.2.0.0~31 X-Git-Url: https://glassweightruler.freedombox.rocks/gitweb/xdg-ninja.git/commitdiff_plain/423726fc992211893ed74e63a3ccd907b7163280?ds=sidebyside Separate prompts --- diff --git a/lib/AddProgram.hs b/lib/AddProgram.hs index 77272ee..5a145ad 100644 --- a/lib/AddProgram.hs +++ b/lib/AddProgram.hs @@ -17,6 +17,8 @@ import Data.UUID import Data.UUID.V4 import GHC.Float (double2Float) import GHC.Generics +import Program +import Prompts import System.Console.Haskeline import System.Environment (getEnv) import System.Exit @@ -24,82 +26,14 @@ import System.IO import System.Process import Text.Printf (printf) -data File = File - { path :: String, - supportLevel :: SupportLevel, - help :: String - } - deriving (Generic, Show) - -instance ToJSON File where - toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help) - -data Program = Program - { name :: T.Text, - files :: [File] - } - deriving (Generic, Show) - -instance ToJSON Program where - toEncoding = genericToEncoding defaultOptions - -save :: Program -> IO () -save program = do - let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json") - B.writeFile path (encodePretty program) - -data SupportLevel = Unsupported | Alias | EnvVars | Supported - deriving (Generic, Show) - -instance ToJSON SupportLevel where - toEncoding Unsupported = toEncoding ( Bool False ) - toEncoding _ = toEncoding ( Bool True ) - getTemplate :: SupportLevel -> String getTemplate Unsupported = "Currently unsupported.\n\n_Relevant issue:_ https://github.com/user/repo/issues/nr\n" getTemplate EnvVars = "Export the following environment variables:\n\n```bash\n\n```" getTemplate Alias = "Alias PROGRAM to use a custom configuration location:\n\n```bash\nalias PROGRAM=PROGRAM --config \"$XDG_CONFIG_HOME\"/PROGRAM/config\n```\n" getTemplate Supported = "Supported since _VERSION_.\n\nYou can move the file to _XDG_CONFIG_HOME/PROGRAM/CONFIG.\n" - getHelp :: SupportLevel -> IO String -getHelp supportLevel = do - id <- toString <$> Data.UUID.V4.nextRandom - editor <- appendFile ("/tmp/xdg-ninja." ++ id ++ ".md") (getTemplate supportLevel) >> (getEnv "EDITOR") - (_, _, _, p) <- createProcess (shell (editor ++ " /tmp/xdg-ninja." ++ id ++ ".md")) - f <- waitForProcess p - case f of - ExitSuccess -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md") - ExitFailure a -> return "" - -getProp :: T.Text -> T.Text -> IO String -getProp prompt placeholder = do - let string_prompt = T.unpack prompt - let string_placholder = T.unpack placeholder - x <- runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, "")) - case x of - Just s -> return s - Nothing -> return "" - -data Answer = Yes | No | Unknown - -stringToBool :: String -> Answer -stringToBool s = case lower s of - "yes" -> Yes - "y" -> Yes - "1" -> Yes - "no" -> No - "n" -> No - "0" -> No - _ -> Unknown - -promptBool :: T.Text -> T.Text -> T.Text -> IO Bool -promptBool prompt prompt_unrecognised placeholder = do - x <- getProp prompt placeholder - case stringToBool x of - Yes -> return True - No -> return False - Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder +getHelp supportLevel = getInputMarkdown (getTemplate supportLevel) getSupportLevel :: IO SupportLevel getSupportLevel = do diff --git a/lib/Program.hs b/lib/Program.hs new file mode 100644 index 0000000..06adaa2 --- /dev/null +++ b/lib/Program.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module Program where + +import Data.Aeson +import Data.Aeson.Encode.Pretty +import qualified Data.ByteString.Lazy as B +import qualified Data.Text as T +import GHC.Generics + +data File = File + { path :: String, + supportLevel :: SupportLevel, + help :: String + } + deriving (Generic, Show) + +instance ToJSON File where + toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help) + +data Program = Program + { name :: T.Text, + files :: [File] + } + deriving (Generic, Show) + +instance ToJSON Program where + toEncoding = genericToEncoding defaultOptions + +save :: Program -> IO () +save program = do + let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json") + B.writeFile path (encodePretty program) + +data SupportLevel = Unsupported | Alias | EnvVars | Supported + deriving (Generic, Show) + +instance ToJSON SupportLevel where + toEncoding Unsupported = toEncoding ( Bool False ) + toEncoding _ = toEncoding ( Bool True ) + diff --git a/lib/Prompts.hs b/lib/Prompts.hs new file mode 100644 index 0000000..689f203 --- /dev/null +++ b/lib/Prompts.hs @@ -0,0 +1,52 @@ +module Prompts where + +import Data.List.Extra +import qualified Data.Text as T +import Data.UUID +import Data.UUID.V4 +import Program +import System.Console.Haskeline +import System.Environment (getEnv) +import System.Exit +import System.Process +import Text.Printf (printf) + +getInputMarkdown :: String -> IO String +getInputMarkdown placeholder = do + id <- toString <$> Data.UUID.V4.nextRandom + editor <- appendFile ("/tmp/xdg-ninja." ++ id ++ ".md") placeholder >> (getEnv "EDITOR") + (_, _, _, p) <- createProcess (shell (editor ++ " /tmp/xdg-ninja." ++ id ++ ".md")) + f <- waitForProcess p + case f of + ExitSuccess -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md") + ExitFailure a -> return "" + +getProp :: T.Text -> T.Text -> IO String +getProp prompt placeholder = do + let string_prompt = T.unpack prompt + let string_placholder = T.unpack placeholder + x <- runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, "")) + case x of + Just s -> return s + Nothing -> return "" + +data Answer = Yes | No | Unknown + +stringToBool :: String -> Answer +stringToBool s = case lower s of + "yes" -> Yes + "y" -> Yes + "1" -> Yes + "no" -> No + "n" -> No + "0" -> No + _ -> Unknown + +promptBool :: T.Text -> T.Text -> T.Text -> IO Bool +promptBool prompt prompt_unrecognised placeholder = do + x <- getProp prompt placeholder + case stringToBool x of + Yes -> return True + No -> return False + Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder + diff --git a/xdgnj.cabal b/xdgnj.cabal index 939dfa4..6005dd2 100644 --- a/xdgnj.cabal +++ b/xdgnj.cabal @@ -35,7 +35,7 @@ library aeson-pretty ^>=0.8.9, hs-source-dirs: lib default-language: Haskell2010 - exposed-modules: AddProgram + exposed-modules: AddProgram, Program, Prompts executable add-program main-is: add-program.hs