-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Main where
pure "\nThanks for using xyz!"
config :: ProjectConfig -> ExceptT Text IO Text
-config config = pure $ "\nProject details:\n" +++ (unlines $ zipWith (+++) ["Name:\t\t", "Description:\t", "Theme:\t\t", "Editor:\t\t", "Commit command:\t"] [n, d, t, e, ccc]) where
+config config = pure $ "\nProject details:\n\n" +++ (unlines $ zipWith (+++) ["Name:\t\t", "Description:\t", "Theme:\t\t", "Editor:\t\t", "Commit command:\t"] [n, d, t, e, ccc]) where
n = name (config :: ProjectConfig)
d = description (config :: ProjectConfig)
t = theme (config :: ProjectConfig)
Just g -> g
Nothing -> "Not set"
-usage :: IO ()
-usage = putStr . ununlines $ [
+data Command = Command {
+ name :: Text,
+ description :: Text,
+ dispatch :: ExceptT Text IO Text
+ }
+
+commands :: [Command]
+commands = [
+ Command "init" "Initialise a new site" $ init getLocalProjectConfig getGlobalProjectConfig,
+ Command "build" "Build the site" $ resolveProjectConfig >>= build,
+ Command "entry" "Initialise an entry" $ resolveProjectConfig >>= entry,
+ Command "config" "Show project configuration" $ resolveProjectConfig >>= config
+ ]
+
+usage :: [Command] -> ExceptT Text IO Text
+usage c = pure . ununlines $ [
"usage: xyz <command>",
- "Commands:", unlines [
- "\tinit\t\tInitialise a new site",
- "\tbuild\t\tBuild the site",
- "\tentry\t\tInitialise an entry"
- ]
+ "Commands:",
+ unlines $ fmap (\x ->"\t" +++ name (x :: Command) +++ ": " +++ description (x :: Command)) c
]
runExceptTAndOutput :: ExceptT Text IO Text -> IO ()
Left error -> putStrLn error >> (exitWith $ ExitFailure 1)
Right output -> putStrLn output >> exitWith ExitSuccess
+parse :: [Command] -> [Text] -> ExceptT Text IO Text
+parse commands [] = usage commands
+parse commands theCommand = case (lookup 0 ththing) of
+ Just whatever -> dispatch whatever
+ Nothing -> usage commands
+ where ththing = Prelude.zip [0..] (Prelude.filter (\x -> name (x :: Command) == (theCommand !! 0)) commands)
+
main :: IO ()
-main = getArgs >>= parse
-
-parse ["init"] = runExceptTAndOutput $ init getLocalProjectConfig getGlobalProjectConfig
-parse ["build"] = runExceptTAndOutput $ resolveProjectConfig >>= build
-parse ["entry"] = runExceptTAndOutput $ resolveProjectConfig >>= entry
-parse ["config"] = runExceptTAndOutput $ resolveProjectConfig >>= config
-parse [_] = usage
-parse [] = usage
+main = getArgs >>= runExceptTAndOutput . ((parse commands)) . (fmap pack)