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
 
 module Main where
 

-import Data.List (intercalate)
+import Data.List (intercalate, zipWith)

 import Data.String hiding (unlines)
 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 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)
 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 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 Util
 import Data.Bool (bool)

+import Data.Tuple.Curry (uncurryN)
+import qualified Data.ByteString.Lazy as BL
+import Config

 
 main :: IO ()
 main = getArgs >>= parse
 
 main :: IO ()
 main = getArgs >>= parse


@@ -27,48 +36,80 @@ main = getArgs >>= parse
 getGlobalProjectDir :: IO FilePath
 getGlobalProjectDir = getHomeDirectory >>= return . (++ "/.xyz")
 
 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 :: 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 :: 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
 
 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
   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
 
 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
 
 entry :: IO ()
 entry = do

+  config <- resolveProjectConfig

   homeDir <- getHomeDirectory
   entrySpec <- entryPrompt
   entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
   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 ()
 
     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 $ [
 
 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 ["build"] = continueIfValidProject build >> exitSuccess
 parse ["entry"] = continueIfValidProject entry >> exitSuccess

+parse ["config"] = continueIfValidProject config >> exitSuccess

 parse [_] = usage >> exit
 parse [] = usage >> exit
 
 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
 - json
 - filesystem-trees
 - process

+- aeson
+- bytestring
+- tuple

 
 library:
   source-dirs: src
 
 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 #-}
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 


@@ -21,17 +20,12 @@ import System.Directory
 import System.FilePath.Posix (takeBaseName, takeDirectory)
 import Data.Data
 import Data.Typeable
 import System.FilePath.Posix (takeBaseName, takeDirectory)
 import Data.Data
 import Data.Typeable

+import Config

 
 data Theme = Theme {
 
 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,
 
 data Project = Project {
   name :: Text,


@@ -132,13 +126,13 @@ writeOutProject projectConfig files = do
   entryList <- mapM (\raw -> return $ rawTextToEntry raw) rawEntries
   homeDir <- getHomeDirectory
 
   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
   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 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
 
   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)
 
 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"]
 
       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?"
 pushPrompt = yornPrompt "Do you want to push this entry?"