Separate prompts

diff --git a/lib/AddProgram.hs b/lib/AddProgram.hs
index 77272eedeb1daf27047e765e883128ca45caf3ba..5a145ad7027fd098fdff14df46a98ad7d06a1cd2 100644 (file)
--- 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           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
 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)
 
 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"
 
 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 -> 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
 
 getSupportLevel :: IO SupportLevel
 getSupportLevel = do

diff --git a/lib/Program.hs b/lib/Program.hs
new file mode 100644 (file)
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 (file)
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 939dfa4f7074be5d5dc0afaa15baa5fda28f42eb..6005dd2bf4f08b3583fa6df30a2f81c39b5d1d94 100644 (file)
--- a/xdgnj.cabal
+++ b/xdgnj.cabal
@@ -35,7 +35,7 @@ library
         aeson-pretty ^>=0.8.9,
     hs-source-dirs:   lib
     default-language: Haskell2010
         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
 
 executable add-program
     main-is:          add-program.hs