cmt-0.7.1.0: src/Cmt.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}

module Cmt
    ( go
    ) where

import ClassyPrelude

import Data.FileEmbed   (embedFile)
import Data.Text        (stripEnd)
import System.Directory (doesFileExist, removeFile)
import System.Exit      (ExitCode (..), exitFailure, exitSuccess)

import Cmt.IO.CLI           (blank, errorMessage, header, mehssage, message)
import Cmt.IO.Config        (checkFormat, findFile, load, readCfg)
import Cmt.IO.Git           (commit)
import Cmt.IO.Input         (loop)
import Cmt.Output.Format    (format)
import Cmt.Parser.Arguments (parse)
import Cmt.Parser.Config    (predefined)
import Cmt.Types.App        (App, settingsDryRun)
import Cmt.Types.Config     (Config, Outputs)
import Cmt.Types.Next       (Next (..))

helpText :: Text
helpText = decodeUtf8 $(embedFile "templates/usage.txt")

backup :: FilePath
backup = ".cmt.bkp"

failure :: Text -> App
failure msg = errorMessage msg >> lift exitFailure

dryRun :: Text -> App
dryRun txt = do
    header "Result"
    blank
    message txt
    blank
    lift $ writeFile backup (encodeUtf8 txt)
    mehssage "run: cmt --prev to commit"
    lift $ exitSuccess

commitRun :: Text -> App
commitRun txt = do
    commited <- lift (commit $ stripEnd txt)
    case commited of
        ExitSuccess -> lift exitSuccess
        ExitFailure _ -> do
            writeFile backup (encodeUtf8 txt)
            lift exitFailure

send :: Text -> App
send txt = do
    dry <- asks settingsDryRun
    bool commitRun dryRun dry txt

display :: Either Text (Config, Outputs) -> App
display (Left err) = putStrLn err
display (Right (cfg, output)) = do
    parts <- lift $ loop cfg
    send $ format cfg (output ++ parts)

previous :: App
previous = do
    exists <- lift $ doesFileExist backup
    if exists
        then (do txt <- decodeUtf8 <$> readFile backup
                 lift $ removeFile backup
                 send txt)
        else (failure "No previous commit attempts")

predef :: Text -> Outputs -> App
predef name output = do
    cfg <- lift load
    case predefined =<< cfg of
        Left msg -> failure msg
        Right pre ->
            case lookup name pre of
                Nothing -> failure "No matching predefined message"
                Just cf -> display $ checkFormat output cf

configLocation :: App
configLocation = do
    file <- lift findFile
    case file of
        Just path -> putStrLn (pack path)
        Nothing   -> failure ".cmt file not found"

next :: Next -> App
next (Continue output)        = lift (readCfg output) >>= display
next Previous                 = previous
next (PreDefined name output) = predef name output
next Version                  = putStrLn "0.7.1"
next ConfigLocation           = configLocation
next Help                     = putStrLn helpText

go :: IO ()
go = do
    ready <- parse . unwords <$> getArgs
    case ready of
        Right (settings, nxt) -> runReaderT (next nxt) settings
        Left err              -> putStrLn err >> exitFailure