program <- getProgram
do_save <- promptBool (green "Save? (y/n) ") (red "Please provide a valid answer.") ""
if do_save
- then save program
+ then save (makeFilename (name program)) program
else return ()
--- /dev/null
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- I do not know haskell, this code is probably shit
+
+module EditProgram where
+
+import Data.Aeson
+import Data.Aeson.Encode.Pretty
+import Data.Aeson.Parser
+import Data.Aeson.Types
+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 Program
+import Prompts
+import System.Console.Haskeline
+import System.Environment (getEnv)
+import System.Exit
+import System.IO
+import System.Process
+import Text.Printf (printf)
+
+getSupportLevel :: SupportLevel -> IO SupportLevel
+getSupportLevel supportLevel = do
+ changed <- promptBool (blue "Has the support level changed? (y/n) ") (red "Please provide a valid answer.") "y"
+ if not changed
+ then return supportLevel
+ else do
+ movable <- promptBool (blue "Can the file be moved? (y/n) ") (red "Please provide a valid answer.") "y"
+ if movable
+ then do
+ envVars <- promptBool (blue "Do you have to export environment variables? (y/n) ") (red "Please provide a valid answer.") "y"
+ if envVars
+ then return EnvVars
+ else do
+ alias <- promptBool (blue "Do you have to set an alias? (y/n) ") (red "Please provide a valid answer.") "y"
+ if alias
+ then return Alias
+ else return Supported
+ else return Unsupported
+
+
+getHelp :: String -> IO String
+getHelp currentHelp = getInputMarkdown currentHelp
+
+editFile :: File -> IO File
+editFile f = do
+ printf "%s\n" (T.unpack (italic (cyan (T.pack (path f)))))
+ edit <- promptBool (green "Edit this file? (y/n) ") (red "Please provide a valid answer.") ""
+ if not edit
+ then return f
+ else do
+ supportLevel <- getSupportLevel (supportLevel f)
+ help <- getHelp (help f)
+ return File {path = path f, supportLevel = supportLevel, help = help}
+
+readProgram :: String -> IO ( Maybe Program )
+readProgram filename = do
+ json_data <- B.readFile filename
+ return (decode json_data)
+
+editProgram :: String -> IO ()
+editProgram filename = do
+ program <- readProgram filename
+ case program of
+ Nothing -> printf "%s %s\n" (T.unpack (bold (red "Error parsing file"))) (T.unpack (italic (red (T.pack filename))))
+ Just p -> do
+ printf "%s %s\n" (T.unpack (cyan ("Editing"))) (T.unpack (italic (cyan (name p))))
+ files <- return (files p)
+ newFiles <- sequence (map editFile files)
+ do_save <- promptBool (green "Save? (y/n) ") (red "Please provide a valid answer.") ""
+ if do_save
+ then save (T.pack filename) Program {name = (name p), files = newFiles}
+ else return ()
import qualified Data.Text as T
import GHC.Generics
-data File = File
- { path :: String,
- supportLevel :: SupportLevel,
- help :: String
- }
- deriving (Generic, Show)
-
-instance ToJSON File where
- toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help)
+instance FromJSON File where
+ parseJSON (Object v) = File
+ <$> v .: "path"
+ <*> v .: "movable"
+ <*> v .: "help"
data Program = Program
{ name :: T.Text,
deriving (Generic, Show)
instance ToJSON Program where
- toEncoding = genericToEncoding defaultOptions
+ toJSON (Program name files) = object [ "name" .= name, "files" .= files ]
+ toEncoding (Program name files) = pairs ("name" .= name <> "files" .= files)
+instance FromJSON Program
-save :: Program -> IO ()
-save program = do
- let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json")
- B.writeFile path (encodePretty program)
+data File = File
+ { path :: String,
+ supportLevel :: SupportLevel,
+ help :: String
+ }
+ deriving (Generic, Show)
+
+instance ToJSON File where
+ toJSON (File path supportLevel help) = object [ "path" .= path, "movable" .= supportLevel, "help" .= help ]
+ toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help)
data SupportLevel = Unsupported | Alias | EnvVars | Supported
deriving (Generic, Show)
instance ToJSON SupportLevel where
+ toJSON Unsupported = toJSON (Bool False)
+ toJSON _ = toJSON (Bool True)
toEncoding Unsupported = toEncoding ( Bool False )
toEncoding _ = toEncoding ( Bool True )
+instance FromJSON SupportLevel where
+ parseJSON (Bool False) = return Unsupported
+ parseJSON (Bool True) = return EnvVars
+
+makeFilename :: T.Text -> T.Text
+makeFilename s = T.pack ( "./programs/" ++ T.unpack s ++ ".json" )
+save :: T.Text -> Program -> IO ()
+save filename program = do
+ B.writeFile (T.unpack filename) (encodePretty program)
"files": [
{
"path": "$HOME/.cargo",
- "movable": true,
+ "movable": false,
"help": "Export the following environment variables:\n\n```bash\nexport CARGO_HOME=\"$XDG_DATA_HOME\"/cargo\n```\n"
}
],
"files": [
{
"path": "$HOME/.steampid",
- "movable": false,
+ "supportLevel": "Unsupported",
"help": ""
},
{
"path": "$HOME/.steampath",
- "movable": false,
+ "supportLevel": "Supported",
"help": ""
},
{
"path": "$HOME/.steam",
- "movable": false,
- "help": "See the relevant [issue](https://github.com/ValveSoftware/steam-for-linux/issues/1890). It's a goldmine.\n\n> Day 3368\n> A drop or two and follows a river of tears\n> How the cries of the anguished fall on deaf ears\n> A $HOME I believed I'm the one to own\n> Excalibur lifted and this issue remains in stone\n\n"
+ "supportLevel": "Unsupported",
+ "help": "\n"
}
],
"name": "steam"
module Main where
-import AddProgram
+
+import qualified AddProgram as PA
import Data.Semigroup ((<>))
+import qualified EditProgram as PE
import Options.Applicative
data Args = AddProgram
main = do
args <- execParser args
case args of
- AddProgram -> saveProgram
- _ -> print args
+ AddProgram -> PA.saveProgram
+ EditProgram filename -> PE.editProgram filename
+ _ -> print args
aeson-pretty ^>=0.8.9,
hs-source-dirs: lib
default-language: Haskell2010
- exposed-modules: AddProgram, Program, Prompts
+ exposed-modules: AddProgram, Program, Prompts, EditProgram
executable add-program
main-is: add-program.hs
projects / xdg-ninja.git / commitdiff