Better code organization

src/GPM.hs

@@ -23,7 +23,7 @@ gpm = do
   subcmd <- options "Git Project Manager" parser
   case subcmd of
    Init             -> Init.init
-   NewIssue         -> inGPM Issue.newIssue
+   NewIssue         -> inGPM Issue.handleNewIssue
    Review reviewCmd -> inGPM (Review.handleReview reviewCmd)
 
 data Command = Init

src/GPM/Docs.hs

@@ -16,10 +16,10 @@ import           Turtle
 
 import           Data.FileEmbed (embedStringFile)
 
-import           GPM.Helpers    (debug)
+import           GPM.Helpers    (debug_)
 
 init :: IO ()
 init = do
   echo "* wiki.org"
   output "wiki.org" $(embedStringFile "templates/wiki.org")
-  debug "git add wiki.org"
+  debug_ "git add wiki.org"

src/GPM/Helpers.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-|
 module      : GPM.Helpers
 Description : GPM helper functions
@@ -8,32 +7,44 @@ License     : Public Domain
 Maintainer  : yann.esposito@gmail.com
 -}
 module GPM.Helpers
-  (debug,inGPM)
+  (debug,debug_,inGPM,getCurrentGitBranch,getGitUser)
 where
 
-import           Protolude     hiding (stdout,fold,die)
+import           Protolude     hiding (die)
 import           Turtle
 
 import qualified Control.Foldl as Fold
 
-debug :: Text -> IO ()
+-- | execute a shell script and return the last line as text
+-- but also log the command to the console to minimize surprise
+debug :: Text -> IO (Maybe Text)
 debug cmd = do
   putText cmd
-  stdout $ inshell cmd empty
+  fmap lineToText <$> _foldIO (inshell cmd empty) (Fold.generalize Fold.last)
+
+-- | execute a shell script without stdin and without handling output
+debug_ :: Text -> IO ()
+debug_ = void . debug
+
+getCurrentGitBranch :: IO (Maybe Text)
+getCurrentGitBranch = debug "git rev-parse --abbrev-ref HEAD"
+
+getGitUser :: IO (Maybe Text)
+getGitUser = debug "git config user.name"
 
 -- | Ensure actions occurs in the @gpm@ branch
 -- and returns to current branch with also all untracked files
-inGPM :: MonadIO io => IO a -> io ()
+inGPM :: IO a -> IO a
-inGPM actions = sh $ do
+inGPM actions = bracket safeChangeBranch safeReturnBranch (const actions)
-  res <- fold (inshell "git rev-parse --abbrev-ref HEAD" empty) Fold.head
+  where
-  oldbr <- case res of
+    safeChangeBranch = do
-    Nothing -> die "Cannot retrieve current branch"
+      res <- getCurrentGitBranch
-    Just br -> do
+      case res of
-           void $ inshell "git stash --all" empty
+        Nothing -> die "Cannot retrieve current branch"
-           void $ inshell "git checkout gpm" empty
+        Just br -> do
-           return br
+               debug_ "git stash --all"
-  liftIO $ bracket (return ())
+               debug_ "git checkout gpm"
-                   (const $ sh $ do
+               return br
-                       void $ inshell ("git checkout " <> lineToText oldbr) empty
+    safeReturnBranch oldbr = do
-                       void $ inshell "git stash pop" empty)
+      debug_ ("git checkout " <> oldbr)
-                   (const actions)
+      debug_ "git stash pop"

src/GPM/Init.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 
 {-|
 module      : GPM.Init
@@ -15,7 +14,7 @@ where
 import           Protolude
 import           Turtle
 
-import           GPM.Helpers (debug)
+import           GPM.Helpers (debug_)
 import qualified GPM.Docs    as Docs
 import qualified GPM.Issue   as Issue
 import qualified GPM.Review  as Review
@@ -27,13 +26,13 @@ init = do
   Issue.init
   Docs.init
   Review.init
-  debug "git commit -m 'gpm initialized'"
+  debug_ "git commit -m 'gpm initialized'"
-  debug "git checkout master"
+  debug_ "git checkout master"
 
 mkNewEmptyBranch :: Text -> IO ()
 mkNewEmptyBranch br = do
   putText $ "create a new branch " <> br <> " (be sure the branch " <> br <> " doesn't already exists)"
-  debug $ "git checkout --orphan " <> br
+  debug_ $ "git checkout --orphan " <> br
   echo "cleanup the branch"
-  debug "git rm --cached -r ."
+  debug_ "git rm --cached -r ."
 

src/GPM/Issue.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE TemplateHaskell   #-}
 
 {-|
@@ -10,7 +11,7 @@ Maintainer  : yann.esposito@gmail.com
 -}
 module GPM.Issue
   ( init
-  , newIssue
+  , handleNewIssue
   )
 where
 
@@ -18,9 +19,80 @@ import           Protolude      hiding (die)
 import           Turtle
 
 import           Data.FileEmbed (embedStringFile)
+import           GPM.Helpers
+import           Text.Mustache
 
-newIssue :: IO ()
+data NewIssue =
-newIssue = die "TODO"
+  NewIssue { priority    :: Priority
+           , status      :: Text
+           , title       :: Text
+           , user        :: User
+           , branch      :: Maybe Text
+           , tags        :: [Text]
+           , assignee    :: Maybe User
+           , reviewers   :: [User]
+           , description :: Text
+           }
+data Priority = PriorityA | PriorityB | PriorityC
+type User = Text
+
+priorityToText :: Priority -> Text
+priorityToText PriorityA = "[#A]"
+priorityToText PriorityB = "[#B]"
+priorityToText PriorityC = "[#C]"
+
+instance ToMustache NewIssue where
+  toMustache NewIssue{..} = object
+    [ "priority"    ~> priorityToText priority
+    , "status"      ~> status
+    , "title"       ~> title
+    , "user"        ~> user
+    , "branch"      ~> branch
+    , "tags"        ~> tags
+    , "assignee"    ~> assignee
+    , "reviewers"   ~> reviewers
+    , "description" ~> description
+    ]
+
+createTmpNewIssue :: NewIssue -> IO ()
+createTmpNewIssue ni = do
+  ecompiled <- automaticCompile ["./templates"] "new-issue.org"
+  case ecompiled of
+    Left pe -> do
+      print pe
+      die "Parse ERROR, check your template ./templates/new-issue.org"
+    Right compiled -> writeFile ".issues.org.tmp" (substitute compiled ni)
+
+handleNewIssue :: IO ()
+handleNewIssue = do
+  newIssue <- gatherNewIssueInfos
+  createTmpNewIssue newIssue
+  validTmpNewIssue
+
+validTmpNewIssue :: IO ()
+validTmpNewIssue = do
+  tmpIssue <- readFile ".issues.org.tmp"
+  appendFile "issues.org" ("\n\n" <> tmpIssue)
+
+defaultNewIssue :: NewIssue
+defaultNewIssue = NewIssue
+  { priority    = PriorityB
+  , status      = "TODO"
+  , title       = "Issue Title"
+  , user        = "Unknown User"
+  , branch      = Nothing
+  , tags        = []
+  , assignee    = Nothing
+  , reviewers   = []
+  , description = "Write a comprehensive issue description..."
+  }
+
+gatherNewIssueInfos :: IO NewIssue
+gatherNewIssueInfos = do
+  user <- getGitUser
+  branch <- getCurrentGitBranch
+  return $ defaultNewIssue { user = fromMaybe "Unknown User" user
+                           , branch = branch }
 
 init :: IO ()
 init = do

src/GPM/Review.hs

@@ -20,7 +20,7 @@ import           Protolude      hiding (die, (%))
 import           Turtle
 
 import           Data.FileEmbed (embedStringFile)
-import           GPM.Helpers    (debug)
+import           GPM.Helpers    (debug_)
 
 data ReviewCommand = ReviewStart (Maybe Text)
                    | ReviewStop (Maybe Text)
@@ -37,7 +37,7 @@ init = do
   mktree "reviews"
   putText $ format ("* "%fp) fic
   output fic $(embedStringFile "templates/review.org")
-  debug "git add reviews"
+  debug_ "git add reviews"
 
 
 parseReviewCmd :: Parser ReviewCommand