X-Git-Url: https://glassweightruler.freedombox.rocks/gitweb/xdg-ninja.git/blobdiff_plain/82a8d3b99967f60b8d749c8d28132439f944bc33..b1e9bca3febc4ee29b647b1afcd575acf8edeaa2:/app/add-program.hs

diff --git a/app/add-program.hs b/app/add-program.hs
index 1349349..a1446a3 100644
--- a/app/add-program.hs
+++ b/app/add-program.hs
@@ -1,38 +1,39 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- I do not know haskell, this code is probably shit
 
-import Data.Aeson
-import Data.Aeson.Encode.Pretty
-import qualified Data.ByteString.Lazy as B
-import Data.List.Extra
-import Data.Maybe
-import qualified Data.Text as T
-import Data.Text.ANSI
-import Data.UUID
-import Data.UUID.V4
-import GHC.Float (double2Float)
-import GHC.Generics
-import System.Console.Haskeline
-import System.Environment (getEnv)
-import System.Exit
-import System.IO
-import System.Process
-import Text.Printf (printf)
+import           Data.Aeson
+import           Data.Aeson.Encode.Pretty
+import           Data.Aeson.Types
+import qualified Data.ByteString.Lazy     as B
+import           Data.List.Extra
+import           Data.Maybe
+import qualified Data.Text                as T
+import           Data.Text.ANSI
+import           Data.UUID
+import           Data.UUID.V4
+import           GHC.Float                (double2Float)
+import           GHC.Generics
+import           System.Console.Haskeline
+import           System.Environment       (getEnv)
+import           System.Exit
+import           System.IO
+import           System.Process
+import           Text.Printf              (printf)
 
 data File = File
-  { path :: String,
-    movable :: Bool,
-    help :: String
+  { path         :: String,
+    supportLevel :: SupportLevel,
+    help         :: String
   }
   deriving (Generic, Show)
 
 instance ToJSON File where
-  toEncoding = genericToEncoding defaultOptions
+  toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help)
 
 data Program = Program
-  { name :: T.Text,
+  { name  :: T.Text,
     files :: [File]
   }
   deriving (Generic, Show)
@@ -45,14 +46,28 @@ save program = do
   let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json")
   B.writeFile path (encodePretty program)
 
-getHelp :: IO String
-getHelp = do
+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") "Export the following environment variables:\n\n```bash\n\n```" >> (getEnv "EDITOR")
+  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")
+    ExitSuccess   -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md")
     ExitFailure a -> return ""
 
 getProp :: T.Text -> T.Text -> IO String
@@ -61,7 +76,7 @@ getProp prompt placeholder = do
   let string_placholder = T.unpack placeholder
   x <- runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, ""))
   case x of
-    Just s -> return s
+    Just s  -> return s
     Nothing -> return ""
 
 data Answer = Yes | No | Unknown
@@ -69,12 +84,12 @@ 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
+  "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
@@ -84,12 +99,27 @@ promptBool prompt prompt_unrecognised placeholder = do
     No -> return False
     Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder
 
+getSupportLevel :: IO SupportLevel
+getSupportLevel = do
+  movable <- promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
+  if movable
+  then do
+    envVars <- promptBool (blue "Do you have to export environment variables? (y/n) ") (red "Please provide a valid answer.") "y"
+    if envVars
+    then return EnvVars
+    else do
+      alias <- promptBool (blue "Do you have to set an alias? (y/n) ") (red "Please provide a valid answer.") "y"
+      if alias
+      then return Alias
+      else return Supported
+  else return Unsupported
+
 getFile :: IO File
 getFile = do
   path <- getProp (blue "Path to file: ") "$HOME/."
-  movable <- promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
-  help <- getHelp
-  return File {path = path, movable = movable, help = help}
+  supportLevel <- getSupportLevel
+  help <- getHelp supportLevel
+  return File {path = path, supportLevel = supportLevel, help = help}
 
 getFiles :: [File] -> IO [File]
 getFiles files =