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