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