Add add-program tool

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..48a004c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle

diff --git a/add-program.cabal b/add-program.cabal
new file mode 100644 (file)
index 0000000..9bd837a
--- /dev/null
+++ b/add-program.cabal
@@ -0,0 +1,45 @@
+cabal-version:      2.4
+name:               add-program
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             b3nj4m1n
+maintainer:         b3nj4m1n@gmx.net
+
+-- A copyright notice.
+-- copyright:
+-- category:
+
+executable add-program
+    main-is:          add-program.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:
+        base ^>=4.15.1.0,
+        process ^>=1.6.13.2,
+        text,
+        aeson,
+        bytestring,
+        uuid,
+        entropy,
+        haskeline,
+        text-ansi,
+        extra,
+        aeson-pretty,
+    hs-source-dirs:   app
+    default-language: Haskell2010
+

diff --git a/app/add-program.hs b/app/add-program.hs
new file mode 100644 (file)
index 0000000..8018916
--- /dev/null
+++ b/app/add-program.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- I do not know haskell, this code is probably shit
+
+import Data.Aeson
+import Data.Aeson.Encode.Pretty
+import qualified Data.ByteString.Lazy as B
+import Data.List.Extra
+import Data.Maybe
+import qualified Data.Text as T
+import Data.Text.ANSI
+import Data.UUID
+import Data.UUID.V4
+import GHC.Float (double2Float)
+import GHC.Generics
+import System.Console.Haskeline
+import System.Exit
+import System.IO
+import System.Process
+import Text.Printf (printf)
+
+data File = File
+  { path :: String,
+    movable :: Bool,
+    help :: String
+  }
+  deriving (Generic, Show)
+
+instance ToJSON File where
+  toEncoding = genericToEncoding defaultOptions
+
+data Program = Program
+  { name :: T.Text,
+    files :: [File]
+  }
+  deriving (Generic, Show)
+
+instance ToJSON Program where
+  toEncoding = genericToEncoding defaultOptions
+
+save :: Program -> IO ()
+save program = do
+  let path = ( "./programs/" ++ (T.unpack (name program) ) ++ ".json")
+  B.writeFile path (encodePretty program)
+
+getHelp :: IO String
+getHelp =
+  toString <$> Data.UUID.V4.nextRandom >>= \id ->
+    appendFile ( "/tmp/xdg-ninja." ++ id ++ ".md" ) "Export the following environment variables:\n\n```bash\n\n```" >>
+    createProcess (shell ("nvim /tmp/xdg-ninja." ++ id ++ ".md")) >>= \r ->
+      case r of
+        (_, _, _, p) ->
+          waitForProcess p
+            >>= ( \f -> case f of
+                    ExitSuccess -> readFile ("/tmp/xdg-ninja." ++ id ++ ".md")
+                    (ExitFailure a) -> return ""
+                )
+
+getProp :: T.Text -> T.Text -> IO String
+getProp prompt placeholder = do
+  let string_prompt = T.unpack prompt
+  let string_placholder = T.unpack placeholder
+  let fuck = runInputT defaultSettings (getInputLineWithInitial string_prompt (string_placholder, ""))
+  fuck
+    >>= ( \x -> case x of
+            (Just s) -> return s
+            Nothing -> return ""
+        )
+
+data Answer = Yes | No | Unknown
+
+stringToBool :: String -> Answer
+stringToBool s = case lower s of
+  "yes" -> Yes
+  "y" -> Yes
+  "1" -> Yes
+  "no" -> No
+  "n" -> No
+  "0" -> No
+  _ -> Unknown
+
+promptBool :: T.Text -> T.Text -> T.Text -> IO Bool
+promptBool prompt prompt_unrecognised placeholder =
+  getProp prompt placeholder >>= \x -> case stringToBool x of
+    Yes -> return True
+    No -> return False
+    Unknown -> printf "%s\n" prompt_unrecognised >> promptBool prompt prompt_unrecognised placeholder
+
+getFile :: IO File
+getFile =
+  getProp (blue "Path to file: ") "$HOME/."
+    >>= \path ->
+      promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
+        >>= \movable ->
+          getHelp
+            >>= \help -> return File {path = path, movable = movable, help = help}
+
+getFiles :: [File] -> IO [File]
+getFiles files =
+  if Data.List.Extra.null files
+    then getFile >>= \newFile -> getFiles (newFile : files)
+    else
+      promptBool (green "Add another file? (y/n) ") (red "Please provide a valid answer.") "" >>= \new ->
+        if new
+          then getFile >>= \newFile -> getFiles (newFile : files)
+          else return files
+
+getProgram :: IO Program
+getProgram =
+  printf "%s\n" (T.unpack (bold (cyan "XDG-ninja Configuration Wizard")))
+    >> printf "%s\n" (T.unpack (faint (italic (cyan "First, tell me what program you're creating a configuration for."))))
+    >> getProp (yellow "Program name: ") ""
+    >>= \name ->
+      printf "%s\n" (T.unpack (faint (italic (cyan "Alright, now let's configure which files belong to this program.")))) >>
+      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 ~.")))) >>
+      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.")))) >>
+      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.")))) >>
+      getFiles [] >>= \files ->
+        return Program {name = T.pack name, files = files}
+
+main :: IO ()
+main =
+  getProgram
+    >>= save