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 =
  50   toString <$> Data.UUID.V4.nextRandom >>= \id ->
  51     appendFile ("/tmp/xdg-ninja." ++ id ++ ".md") "Export the following environment variables:\n\n```bash\n\n```"
  52       >> (getEnv "EDITOR") >>= \editor ->
  53         createProcess (shell (editor ++ " /tmp/xdg-ninja." ++ id ++ ".md")) >>= \r ->
  54           case r of
  55             (_, _, _, p) ->
  56               waitForProcess p
  57                 >>= ( \f -> case f of
  58                         ExitSuccess -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md")
  59                         (ExitFailure a) -> return ""
  60                     )
  61
  62 getProp :: T.Text -> T.Text -> IO String
  63 getProp prompt placeholder = do
  64   let string_prompt = T.unpack prompt
  65   let string_placholder = T.unpack placeholder
  66   let fuck = runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, ""))
  67   fuck
  68     >>= ( \x -> case x of
  69             (Just s) -> return s
  70             Nothing -> return ""
  71         )
  72
  73 data Answer = Yes | No | Unknown
  74
  75 stringToBool :: String -> Answer
  76 stringToBool s = case lower s of
  77   "yes" -> Yes
  78   "y" -> Yes
  79   "1" -> Yes
  80   "no" -> No
  81   "n" -> No
  82   "0" -> No
  83   _ -> Unknown
  84
  85 promptBool :: T.Text -> T.Text -> T.Text -> IO Bool
  86 promptBool prompt prompt_unrecognised placeholder =
  87   getProp prompt placeholder >>= \x -> case stringToBool x of
  88     Yes -> return True
  89     No -> return False
  90     Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder
  91
  92 getFile :: IO File
  93 getFile =
  94   getProp (blue "Path to file: ") "$HOME/."
  95     >>= \path ->
  96       promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
  97         >>= \movable ->
  98           getHelp
  99             >>= \help -> return File {path = path, movable = movable, help = help}
 100
 101 getFiles :: [File] -> IO [File]
 102 getFiles files =
 103   if Data.List.Extra.null files
 104     then getFile >>= \newFile -> getFiles (newFile : files)
 105     else
 106       promptBool (green "Add another file? (y/n) ") (red "Please provide a valid answer.") "" >>= \new ->
 107         if new
 108           then getFile >>= \newFile -> getFiles (newFile : files)
 109           else return files
 110
 111 getProgram :: IO Program
 112 getProgram =
 113   printf "%s\n" (T.unpack (bold (cyan "XDG-ninja Configuration Wizard")))
 114     >> printf "%s\n" (T.unpack (faint (italic (cyan "First, tell me what program you're creating a configuration for."))))
 115     >> getProp (yellow "Program name: ") ""
 116     >>= \name ->
 117       printf "%s\n" (T.unpack (faint (italic (cyan "Alright, now let's configure which files belong to this program."))))
 118         >> 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 ~."))))
 119         >> 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."))))
 120         >> 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."))))
 121         >> getFiles [] >>= \files ->
 122           return Program {name = T.pack name, files = files}
 123
 124 main :: IO ()
 125 main =
 126   getProgram >>= \program ->
 127     promptBool (green "Save? (y/n) ") (red "Please provide a valid answer.") "" >>= \do_save ->
 128       if do_save
 129         then save program
 130         else return ()