Refactor:

- Use aeson for JSON stuff
- Create a config module with a notion of local, global, and project configs
- Start working git in to the command flow more

diff --git a/app/Main.hs b/app/Main.hs
index 597bb89..9469690 100644 (file)
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,14 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module Main where
 
-import Data.List (intercalate)
+import Data.List (intercalate, zipWith)
 import Data.String hiding (unlines)
-import Data.Text hiding (map, init, length, splitAt)
+import Data.Text hiding (map, init, length, splitAt, foldl, zipWith)
 import Data.Text.IO (putStrLn, putStr, writeFile)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Template
 import Data.Time.Clock.POSIX
 import Lib
-import Prelude hiding (putStrLn, putStr, init, unlines, writeFile)
+import Prelude hiding (putStrLn, putStr, init, unlines, writeFile, zipWith)
 import Prompts
 import System.Directory
 import System.Directory (doesFileExist)
@@ -16,10 +20,15 @@ import System.Environment
 import System.Exit
 import System.File.Tree hiding (map, mapM, mapM_)
 import System.Process
-import Text.JSON
-import Text.JSON.Generic
+import Data.Aeson
+import Data.Aeson.TH
+import Data.Aeson.Text
+import Data.Maybe
 import Util
 import Data.Bool (bool)
+import Data.Tuple.Curry (uncurryN)
+import qualified Data.ByteString.Lazy as BL
+import Config
 
 main :: IO ()
 main = getArgs >>= parse
@@ -27,48 +36,80 @@ main = getArgs >>= parse
 getGlobalProjectDir :: IO FilePath
 getGlobalProjectDir = getHomeDirectory >>= return . (++ "/.xyz")
 
-getGlobalProjectConfig :: IO FilePath
-getGlobalProjectConfig = getGlobalProjectDir >>= return . (++ "/xyz.json")
+getGlobalProjectConfigPath :: IO FilePath
+getGlobalProjectConfigPath = getGlobalProjectDir >>= return . (++ "/xyz.json")
+
+getGlobalProjectConfig :: IO (Maybe GlobalConfig)
+getGlobalProjectConfig = getGlobalProjectConfigPath >>= BL.readFile >>= return . decode
+
+getLocalProjectConfig :: IO (Maybe LocalConfig)
+getLocalProjectConfig = BL.readFile "xyz.json" >>= return . decode
+
+resolveProjectConfig :: IO (Maybe ProjectConfig)
+resolveProjectConfig = do
+  l <- getLocalProjectConfig
+  g <- getGlobalProjectConfig
+
+  return $ case (l, g) of
+    (Just l, Just g) -> Just $ getProjectConfig g l
+    (_, _) -> Nothing
 
 continueIfValidProject :: IO () -> IO ()
-continueIfValidProject next = doesFileExist "xyz.json" >>=  bool (putStrLn "This does not appear to be a valid project directory") next
+continueIfValidProject next = doesFileExist "xyz.json" >>= bool (putStrLn "This does not appear to be a valid project directory") next
+
+continueIfInvalidProject :: IO () -> IO ()
+continueIfInvalidProject next = doesFileExist "xyz.json" >>= bool next (putStrLn "Project already initialised")
 
 initGlobalIfNeeded :: IO () -> IO ()
-initGlobalIfNeeded next = getGlobalProjectConfig >>= doesFileExist >>= bool globalInit (return ()) >> next
+initGlobalIfNeeded next = getGlobalProjectConfigPath >>= doesFileExist >>= bool globalInit (return ()) >> next
 
 globalInit :: IO ()
 globalInit = do
   home <- getHomeDirectory
   putStrLn "\nWelcome to xyz! Looks like this is your first time here. Let's configure a few things...\n"
   editor <- editorPrompt
-  writeFile (home ++ "/.xyz/xyz.json") (pack . encode . toJSObject $ [("editor", editor)])
+  vcs <- vcsPrompt -- >>= (\x -> return $ if x then Just "git add . && git commit -m \"$title\"" else Nothing)
+  let pushCmdAndRemote = case vcs of
+        Just (True, x) -> [("pushCommand", "git add . && git commit -m \"$title\""), ("remote", x)]
+        Nothing -> []
+
+  getGlobalProjectConfigPath >>= flip writeFile (toStrict . encodeToLazyText $ GlobalConfig editor (lookup "pushCommand" pushCmdAndRemote) (lookup "remote" pushCmdAndRemote))
   putStrLn "\nThanks! Now let's continue with initialising your project...\n"
 
 init :: IO ()
 init = do
-  dirExists <- doesFileExist "xyz.json"
-  if dirExists
-    then putStrLn "Project already initialised"
-    else do home <- getHomeDirectory
-            themes <- allFilesIn $ home ++ "/.xyz/themes"
-            projectSpec <- initPrompt (map pack themes)
-            createDirectory "entries"
-            writeFile "xyz.json" . pack . encode . toJSObject $ projectSpec
-            putStrLn "\nInitialised empty project"
+  home <- getHomeDirectory
+  themes <- allFilesIn $ home ++ "/.xyz/themes"
+  projectSpec <- (initPrompt (map pack themes)) >>= return . fmap snd >>= (\[x,y,z] -> return (x, y, z, Nothing, Nothing, Nothing))
+  let localConfig = uncurryN LocalConfig projectSpec
+  writeFile "xyz.json" (toStrict . encodeToLazyText $ localConfig)
+  config <- resolveProjectConfig
+
+  case config of
+    Just projectConfig -> do
+      createDirectory "entries"
+
+      case (commitCommand (projectConfig :: ProjectConfig), gitRemote (projectConfig :: ProjectConfig)) of
+        (Just cmd, Just remote) -> do
+          mapM_ (callCommand . unpack . ((+++) " > /dev/unll")) ["git init", "git remote add origin " +++ remote, "git add . && git commit -m \"Initial commit\""]
+        (_, _) -> return()
+
+      putStrLn "\nInitialised empty project"
+    Nothing -> do
+      putStrLn "\nSomething went real wrong"
 
 build :: IO ()
 build = do
-  fileExists <- doesFileExist "xyz.json"
-  if fileExists
-    then do
-        files <- allFilesIn "entries"
-        home <- getHomeDirectory
-        config <- readFile "xyz.json"
-        writeOutProject (decodeJSON config :: ProjectConfig) files >> putStrLn "Build successful"
-    else putStrLn "This does not appear to be a valid project directory"
+  files <- allFilesIn "entries"
+  config <- resolveProjectConfig
+
+  case config of
+    Just c -> writeOutProject c files >> putStrLn "Build successful"
+    _ -> putStrLn "Busted"
 
 entry :: IO ()
 entry = do
+  config <- resolveProjectConfig
   homeDir <- getHomeDirectory
   entrySpec <- entryPrompt
   entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
@@ -93,7 +134,23 @@ entry = do
     True -> do callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
     False -> return ()
 
-  putStrLn "Thanks for using xyz!"
+  putStrLn "\nThanks for using xyz!"
+
+config :: IO ()
+config = do
+  config <- resolveProjectConfig
+  case config of
+    Just (ProjectConfig {
+             name=n,
+             description=d,
+             theme=t,
+             editor=e,
+             commitCommand=cc
+             }) -> (putStrLn "\nProject details:\n") >> (putStr . unlines $ zipWith (+++) ["Name:\t\t", "Description:\t", "Theme:\t\t", "Editor:\t\t", "Commit command:\t"] [n, d, t, e, ccc]) where
+      ccc = case cc of
+        Just g -> g
+        Nothing -> "Not set"
+    Nothing -> putStrLn "broken"
 
 usage :: IO ()
 usage =  putStr . ununlines $ [
@@ -105,9 +162,10 @@ usage =  putStr . ununlines $ [
                        ]
   ]
 
-parse ["init"] = initGlobalIfNeeded init >> exitSuccess
+parse ["init"] =  initGlobalIfNeeded (continueIfInvalidProject init) >> exitSuccess
 parse ["build"] = continueIfValidProject build >> exitSuccess
 parse ["entry"] = continueIfValidProject entry >> exitSuccess
+parse ["config"] = continueIfValidProject config >> exitSuccess
 parse [_] = usage >> exit
 parse [] = usage >> exit
 

diff --git a/package.yaml b/package.yaml
index 16347e0..bd718e3 100644 (file)
--- a/package.yaml
+++ b/package.yaml
@@ -28,6 +28,9 @@ dependencies:
 - json
 - filesystem-trees
 - process
+- aeson
+- bytestring
+- tuple
 
 library:
   source-dirs: src

diff --git a/src/Config.hs b/src/Config.hs
new file mode 100644 (file)
index 0000000..8082c88
--- /dev/null
+++ b/src/Config.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Config where
+
+import GHC.Generics
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Text hiding (map, init, length, splitAt, zip)
+import Data.Text.Lazy (toStrict)
+import Data.Aeson
+import Data.Aeson.TH
+import Data.Aeson.Text
+
+data GlobalConfig = GlobalConfig {
+  editor :: Text,
+  commitCommand :: Maybe Text,
+  gitRemote :: Maybe Text
+  } deriving (Show, Generic)
+
+data LocalConfig = LocalConfig {
+  name :: Text,
+  description :: Text,
+  theme :: Text,
+  editor :: Maybe Text,
+  commitCommand :: Maybe Text,
+  gitRemote :: Maybe Text
+  } deriving (Show, Generic)
+
+data ProjectConfig = ProjectConfig {
+  name :: Text,
+  description :: Text,
+  theme :: Text,
+  editor :: Text,
+  commitCommand :: Maybe Text,
+  gitRemote :: Maybe Text
+  } deriving (Show, Generic)
+
+instance ToJSON GlobalConfig where
+  toJSON = genericToJSON defaultOptions
+    { omitNothingFields = False }
+
+instance FromJSON GlobalConfig where
+  parseJSON = genericParseJSON defaultOptions
+    { omitNothingFields = False }
+
+instance ToJSON LocalConfig where
+  toJSON = genericToJSON defaultOptions
+    { omitNothingFields = True }
+
+instance FromJSON LocalConfig where
+  parseJSON = genericParseJSON defaultOptions
+    { omitNothingFields = True }
+
+maybeTrump :: LocalConfig -> GlobalConfig -> (LocalConfig -> Maybe a) -> (GlobalConfig -> Maybe a) -> Maybe a
+maybeTrump l g lf gf = case lf l of
+  Just x -> Just x
+  Nothing -> gf g
+
+trump :: LocalConfig -> GlobalConfig -> (LocalConfig -> Maybe a) -> (GlobalConfig -> a) -> a
+trump l g lf gf = case lf l of
+  Just x -> x
+  Nothing -> gf g
+
+getProjectConfig :: GlobalConfig -> LocalConfig -> ProjectConfig
+getProjectConfig g l = ProjectConfig
+  (name (l :: LocalConfig))
+  (description (l :: LocalConfig))
+  (theme (l :: LocalConfig))
+  (trumper editor editor)
+  (maybeTrumper commitCommand commitCommand)
+  (maybeTrumper gitRemote gitRemote)
+  where
+    trumper = trump l g
+    maybeTrumper = maybeTrump l g

diff --git a/src/Lib.hs b/src/Lib.hs
index 123e315..9798de0 100644 (file)
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
@@ -21,17 +20,12 @@ import System.Directory
 import System.FilePath.Posix (takeBaseName, takeDirectory)
 import Data.Data
 import Data.Typeable
+import Config
 
 data Theme = Theme {
-  name :: String, -- works better with getHomeDirectory
-  templates :: [(String, Template)]
-    } deriving (Show)
-
-data ProjectConfig = ProjectConfig {
-  name :: Text,
-  description :: Text,
-  theme :: String -- as above
-  } deriving (Show, Data, Typeable)
+  name :: Text, -- works better with getHomeDirectory
+  templates :: [(Text, Template)]
+  } deriving (Show)
 
 data Project = Project {
   name :: Text,
@@ -132,13 +126,13 @@ writeOutProject projectConfig files = do
   entryList <- mapM (\raw -> return $ rawTextToEntry raw) rawEntries
   homeDir <- getHomeDirectory
 
-  let themeName = theme (projectConfig :: ProjectConfig)
+  let themeName = unpack $ theme (projectConfig :: ProjectConfig)
   themeTemplatePaths <- allFilesIn $ homeDir ++ "/.xyz/themes/" ++ themeName
-  themeTemplates <- mapM (\x -> (readFile $ homeDir ++ "/.xyz/themes/" ++ themeName ++ "/" ++ x) >>= (\y -> return (x, (template . fromString) y))) themeTemplatePaths
+  themeTemplates <- mapM (\x -> (readFile $ homeDir ++ "/.xyz/themes/" ++ themeName ++ "/" ++ x) >>= (\y -> return (pack x, (template . fromString) y))) themeTemplatePaths
 
   let projectName = name (projectConfig :: ProjectConfig)
   let projectDescription = description (projectConfig :: ProjectConfig)
-  let project = Project projectName projectDescription (Theme themeName themeTemplates) (stampsToEntryList entryList)
+  let project = Project projectName projectDescription (Theme (pack themeName) themeTemplates) (stampsToEntryList entryList)
 
   mapM_ (createDirectoryIfMissing True . takeDirectory . unpack . fst) $ getEntryPages project
   mapM_ (\x -> writeFile (unpack $ fst x) (unpack $ snd x)) $ getEntryPages project

diff --git a/src/Prompts.hs b/src/Prompts.hs
index 846d019..e2fccf1 100644 (file)
--- a/src/Prompts.hs
+++ b/src/Prompts.hs
@@ -1,4 +1,4 @@
-module Prompts (entryPrompt, initPrompt, pushPrompt, editorPrompt) where
+module Prompts (entryPrompt, initPrompt, pushPrompt, editorPrompt, vcsPrompt) where
 
 import Util
 import Prelude hiding (getLine, null, putStrLn, putStr, unlines)
@@ -88,4 +88,13 @@ editorPrompt = filterM (system . unpack . (+++ " > /dev/null") . ("which " +++)
       ExitSuccess -> True
     commonEditors =   ["vi", "vim", "nano", "emacs"]
 
+vcsPrompt :: IO (Maybe (Bool, Text))
+vcsPrompt = do
+  gitInstalled <- (system . unpack $ "which git > /dev/null") >>= return . codeToBool
+  if gitInstalled then dependantYornTextPrompt "I detected git on your system. Would you like to use it to version entries?" "Which remote should I use? " else return Nothing
+  where
+    codeToBool x = case x of
+      ExitFailure _ -> False
+      ExitSuccess -> True
+
 pushPrompt = yornPrompt "Do you want to push this entry?"