app/add-program.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3
   4 -- I do not know haskell, this code is probably shit
   5
   6 import Data.Aeson
   7 import Data.Aeson.Encode.Pretty
   8 import qualified Data.ByteString.Lazy as B
   9 import Data.List.Extra
  10 import Data.Maybe
  11 import qualified Data.Text as T
  12 import Data.Text.ANSI
  13 import Data.UUID
  14 import Data.UUID.V4
  15 import GHC.Float (double2Float)
  16 import GHC.Generics
  17 import System.Console.Haskeline
  18 import System.Environment (getEnv)
  19 import System.Exit
  20 import System.IO
  21 import System.Process
  22 import Text.Printf (printf)
  23
  24 data File = File
  25   { path :: String,
  26     movable :: Bool,
  27     help :: String
  28   }
  29   deriving (Generic, Show)
  30
  31 instance ToJSON File where
  32   toEncoding = genericToEncoding defaultOptions
  33
  34 data Program = Program
  35   { name :: T.Text,
  36     files :: [File]
  37   }
  38   deriving (Generic, Show)
  39
  40 instance ToJSON Program where
  41   toEncoding = genericToEncoding defaultOptions
  42
  43 save :: Program -> IO ()
  44 save program = do
  45   let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json")
  46   B.writeFile path (encodePretty program)
  47
  48 getHelp :: IO String
  49 getHelp = do
  50   id <- toString <$> Data.UUID.V4.nextRandom
  51   editor <- appendFile ("/tmp/xdg-ninja." ++ id ++ ".md") "Export the following environment variables:\n\n```bash\n\n```" >> (getEnv "EDITOR")
  52   (_, _, _, p) <- createProcess (shell (editor ++ " /tmp/xdg-ninja." ++ id ++ ".md"))
  53   f <- waitForProcess p
  54   case f of
  55     ExitSuccess -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md")
  56     ExitFailure a -> return ""
  57
  58 getProp :: T.Text -> T.Text -> IO String
  59 getProp prompt placeholder = do
  60   let string_prompt = T.unpack prompt
  61   let string_placholder = T.unpack placeholder
  62   x <- runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, ""))
  63   case x of
  64     Just s -> return s
  65     Nothing -> return ""
  66
  67 data Answer = Yes | No | Unknown
  68
  69 stringToBool :: String -> Answer
  70 stringToBool s = case lower s of
  71   "yes" -> Yes
  72   "y" -> Yes
  73   "1" -> Yes
  74   "no" -> No
  75   "n" -> No
  76   "0" -> No
  77   _ -> Unknown
  78
  79 promptBool :: T.Text -> T.Text -> T.Text -> IO Bool
  80 promptBool prompt prompt_unrecognised placeholder = do
  81   x <- getProp prompt placeholder
  82   case stringToBool x of
  83     Yes -> return True
  84     No -> return False
  85     Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder
  86
  87 getFile :: IO File
  88 getFile = do
  89   path <- getProp (blue "Path to file: ") "$HOME/."
  90   movable <- promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
  91   help <- getHelp
  92   return File {path = path, movable = movable, help = help}
  93
  94 getFiles :: [File] -> IO [File]
  95 getFiles files =
  96   if Data.List.Extra.null files
  97   then do
  98     newFile <- getFile
  99     getFiles (newFile : files)
 100   else do
 101     new <- promptBool (green "Add another file? (y/n) ") (red "Please provide a valid answer.") ""
 102     if new
 103     then do
 104       newFile <- getFile
 105       getFiles (newFile : files)
 106     else return files
 107
 108 getProgram :: IO Program
 109 getProgram = do
 110   name <- printf "%s\n" (T.unpack (bold (cyan "XDG-ninja Configuration Wizard")))
 111           >> printf "%s\n" (T.unpack (faint (italic (cyan "First, tell me what program you're creating a configuration for."))))
 112           >> getProp (yellow "Program name: ") ""
 113   files <- printf "%s\n" (T.unpack (faint (italic (cyan "Alright, now let's configure which files belong to this program."))))
 114            >> 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 ~."))))
 115            >> 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."))))
 116            >> 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."))))
 117            >> getFiles []
 118   return Program {name = T.pack name, files = files}
 119
 120 main :: IO ()
 121 main = do
 122   program <- getProgram
 123   do_save <- promptBool (green "Save? (y/n) ") (red "Please provide a valid answer.") ""
 124   if do_save
 125   then save program
 126   else return ()