-- Copyright 2016 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE OverloadedStrings #-}
-- | Functions to deal with local source control.
module Util.SourceControl (Entry(..), current, showDate) where
import qualified Data.Text as Text
import           Data.Text (Text)
import qualified Data.Time as Time
import qualified Data.Time.Clock.POSIX as Clock.POSIX

import qualified System.Exit as Exit
import qualified System.Process as Process

import qualified Util.ParseText as ParseText


type Error = String

data Entry = Entry {
    Entry -> Text
_author :: !Text
    , Entry -> UTCTime
_date :: !Time.UTCTime
    , Entry -> Text
_hash :: !Text
    , Entry -> Text
_summary :: !Text
    } deriving (Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> Error
forall a.
(Int -> a -> ShowS) -> (a -> Error) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> Error
$cshow :: Entry -> Error
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)

current :: FilePath -> IO (Either Error Entry)
current :: Error -> IO (Either Error Entry)
current = Error -> IO (Either Error Entry)
currentPatchGit

showDate :: Time.UTCTime -> Text
showDate :: UTCTime -> Text
showDate = Error -> Text
Text.pack
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> Error -> t -> Error
Time.formatTime TimeLocale
Time.defaultTimeLocale Error
"%Y-%m-%dT%H:%M:%S"

-- * git

currentPatchGit :: FilePath -> IO (Either Error Entry)
currentPatchGit :: Error -> IO (Either Error Entry)
currentPatchGit Error
dir = (Text -> Either Error Entry
parseGit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Text
Text.pack =<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Error -> IO (Either Error Error)
getCurrentPatchGit Error
dir

getCurrentPatchGit :: FilePath -> IO (Either Error String)
getCurrentPatchGit :: Error -> IO (Either Error Error)
getCurrentPatchGit Error
dir = do
    (ExitCode
exit, Error
stdout, Error
stderr) <- CreateProcess -> Error -> IO (ExitCode, Error, Error)
Process.readCreateProcessWithExitCode
        ((Error -> [Error] -> CreateProcess
Process.proc Error
"git" [Error
"log", Error
"-n1", Error
"--format=%H%n%ae%n%at%n%s"])
            { cwd :: Maybe Error
Process.cwd = forall a. a -> Maybe a
Just Error
dir })
        Error
""
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ExitCode
exit of
        Exit.ExitFailure Int
n ->
            forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Error
"git failed with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Error
show Int
n forall a. Semigroup a => a -> a -> a
<> Error
": " forall a. Semigroup a => a -> a -> a
<> Error
stderr
        ExitCode
Exit.ExitSuccess -> forall a b. b -> Either a b
Right Error
stdout

-- 1c1aa1db8eb8ae5ec76507f27ab6a6a3107a76f6
-- qdunkan@gmail.com
-- 2018-02-16T02:49:11+00:00
-- clean up the last of the -Wmissing-monadfail-instances warnings
parseGit :: Text -> Either Error Entry
parseGit :: Text -> Either Error Entry
parseGit = [Text] -> Either Error Entry
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
    where
    parse :: [Text] -> Either Error Entry
parse [Text
hash, Text
author, Text
timestamp, Text
summary] = do
        Int
timestamp <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Error
"can't parse timestamp: " forall a. Semigroup a => a -> a -> a
<> Text -> Error
Text.unpack Text
timestamp) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
            Text -> Maybe Int
ParseText.int Text
timestamp
        let date :: UTCTime
date = POSIXTime -> UTCTime
Clock.POSIX.posixSecondsToUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timestamp)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Entry
            { _author :: Text
_author = Text
author
            , _date :: UTCTime
_date = UTCTime
date
            , _hash :: Text
_hash = Text
hash
            , _summary :: Text
_summary = Text
summary
            }
    parse [Text]
_ = forall a b. a -> Either a b
Left Error
"expected 4 lines"