lib/AddProgram.hs

   1 {-# LANGUAGE DeriveGeneric     #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3
   4 -- I do not know haskell, this code is probably shit
   5
   6 module AddProgram where
   7
   8 import           Data.Aeson
   9 import           Data.Aeson.Encode.Pretty
  10 import           Data.Aeson.Types
  11 import qualified Data.ByteString.Lazy     as B
  12 import           Data.List.Extra
  13 import           Data.Maybe
  14 import qualified Data.Text                as T
  15 import           Data.Text.ANSI
  16 import           Data.UUID
  17 import           Data.UUID.V4
  18 import           GHC.Float                (double2Float)
  19 import           GHC.Generics
  20 import           System.Console.Haskeline
  21 import           System.Environment       (getEnv)
  22 import           System.Exit
  23 import           System.IO
  24 import           System.Process
  25 import           Text.Printf              (printf)
  26
  27 data File = File
  28   { path         :: String,
  29     supportLevel :: SupportLevel,
  30     help         :: String
  31   }
  32   deriving (Generic, Show)
  33
  34 instance ToJSON File where
  35   toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help)
  36
  37 data Program = Program
  38   { name  :: T.Text,
  39     files :: [File]
  40   }
  41   deriving (Generic, Show)
  42
  43 instance ToJSON Program where
  44   toEncoding = genericToEncoding defaultOptions
  45
  46 save :: Program -> IO ()
  47 save program = do
  48   let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json")
  49   B.writeFile path (encodePretty program)
  50
  51 data SupportLevel = Unsupported | Alias | EnvVars | Supported
  52   deriving (Generic, Show)
  53
  54 instance ToJSON SupportLevel where
  55   toEncoding Unsupported = toEncoding ( Bool False )
  56   toEncoding _           = toEncoding ( Bool True )
  57
  58 getTemplate :: SupportLevel -> String
  59 getTemplate Unsupported = "Currently unsupported.\n\n_Relevant issue:_ https://github.com/user/repo/issues/nr\n"
  60 getTemplate EnvVars = "Export the following environment variables:\n\n```bash\n\n```"
  61 getTemplate Alias = "Alias PROGRAM to use a custom configuration location:\n\n```bash\nalias PROGRAM=PROGRAM --config \"$XDG_CONFIG_HOME\"/PROGRAM/config\n```\n"
  62 getTemplate Supported = "Supported since _VERSION_.\n\nYou can move the file to _XDG_CONFIG_HOME/PROGRAM/CONFIG.\n"
  63
  64
  65 getHelp :: SupportLevel -> IO String
  66 getHelp supportLevel = do
  67   id <- toString <$> Data.UUID.V4.nextRandom
  68   editor <- appendFile ("/tmp/xdg-ninja." ++ id ++ ".md") (getTemplate supportLevel) >> (getEnv "EDITOR")
  69   (_, _, _, p) <- createProcess (shell (editor ++ " /tmp/xdg-ninja." ++ id ++ ".md"))
  70   f <- waitForProcess p
  71   case f of
  72     ExitSuccess   -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md")
  73     ExitFailure a -> return ""
  74
  75 getProp :: T.Text -> T.Text -> IO String
  76 getProp prompt placeholder = do
  77   let string_prompt = T.unpack prompt
  78   let string_placholder = T.unpack placeholder
  79   x <- runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, ""))
  80   case x of
  81     Just s  -> return s
  82     Nothing -> return ""
  83
  84 data Answer = Yes | No | Unknown
  85
  86 stringToBool :: String -> Answer
  87 stringToBool s = case lower s of
  88   "yes" -> Yes
  89   "y"   -> Yes
  90   "1"   -> Yes
  91   "no"  -> No
  92   "n"   -> No
  93   "0"   -> No
  94   _     -> Unknown
  95
  96 promptBool :: T.Text -> T.Text -> T.Text -> IO Bool
  97 promptBool prompt prompt_unrecognised placeholder = do
  98   x <- getProp prompt placeholder
  99   case stringToBool x of
 100     Yes -> return True
 101     No -> return False
 102     Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder
 103
 104 getSupportLevel :: IO SupportLevel
 105 getSupportLevel = do
 106   movable <- promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
 107   if movable
 108   then do
 109     envVars <- promptBool (blue "Do you have to export environment variables? (y/n) ") (red "Please provide a valid answer.") "y"
 110     if envVars
 111     then return EnvVars
 112     else do
 113       alias <- promptBool (blue "Do you have to set an alias? (y/n) ") (red "Please provide a valid answer.") "y"
 114       if alias
 115       then return Alias
 116       else return Supported
 117   else return Unsupported
 118
 119 getFile :: IO File
 120 getFile = do
 121   path <- getProp (blue "Path to file: ") "$HOME/."
 122   supportLevel <- getSupportLevel
 123   help <- getHelp supportLevel
 124   return File {path = path, supportLevel = supportLevel, help = help}
 125
 126 getFiles :: [File] -> IO [File]
 127 getFiles files =
 128   if Data.List.Extra.null files
 129   then do
 130     newFile <- getFile
 131     getFiles (newFile : files)
 132   else do
 133     new <- promptBool (green "Add another file? (y/n) ") (red "Please provide a valid answer.") ""
 134     if new
 135     then do
 136       newFile <- getFile
 137       getFiles (newFile : files)
 138     else return files
 139
 140 getProgram :: IO Program
 141 getProgram = do
 142   name <- printf "%s\n" (T.unpack (bold (cyan "XDG-ninja Configuration Wizard")))
 143           >> printf "%s\n" (T.unpack (faint (italic (cyan "First, tell me what program you're creating a configuration for."))))
 144           >> getProp (yellow "Program name: ") ""
 145   files <- printf "%s\n" (T.unpack (faint (italic (cyan "Alright, now let's configure which files belong to this program."))))
 146            >> printf "%s\n" (T.unpack (faint (italic (cyan "I'm going to ask you for the path to the file, please use $HOME instead of ~."))))
 147            >> printf "%s\n" (T.unpack (faint (italic (cyan "I'll then ask you wether or not this file can be moved to a different directory."))))
 148            >> printf "%s\n" (T.unpack (faint (italic (cyan "Finally, your editor is going to open a markdown document. Enter instructions on moving the file in question, then save and close."))))
 149            >> getFiles []
 150   return Program {name = T.pack name, files = files}
 151
 152 saveProgram :: IO ()
 153 saveProgram = do
 154   program <- getProgram
 155   do_save <- promptBool (green "Save? (y/n) ") (red "Please provide a valid answer.") ""
 156   if do_save
 157   then save program
 158   else return ()