jot-0.1.0.0: app/Main.hs

{-# LANGUAGE QuasiQuotes #-}

module Main where

import Control.Monad         ((>=>), (<=<), liftM2, when)
import Control.Monad.Extra   (unlessM)
import Data.Default          (def, Default)
import Data.Time             (defaultTimeLocale, formatTime, getCurrentTime, toGregorian, UTCTime(..))
import Data.Yaml             (decodeFileEither, FromJSON, ToJSON)
import Dhall                 (auto, input, Generic, Interpret)
import System.Console.Docopt (argument, command, docoptFile, getArg, getArgOrExitWith,
                              isPresent, longOption, parseArgsOrExit, Docopt)
import System.Environment    (getArgs)
import System.FilePath       ((</>), (<.>))
import System.Process        (callProcess)
import Turtle                (append, decodeString, fromString, liftIO, lstree, mktree, sh, testfile)

patterns :: Docopt
patterns = [docoptFile|USAGE.txt|]

getArgOrExit = getArgOrExitWith patterns

data Config = Config { dayFormat :: String, editor :: FilePath, editorOptions :: [String], logBook :: FilePath, timeFormat :: String }
  deriving (Eq, Show, Generic, Interpret, FromJSON, ToJSON)

instance Default Config where
  def = Config "%A %d %B" "vim" ["+"] "notes" "%H:%M"

decodeYamlOrDhall = liftM2 (>>=) decodeFileEither $ flip either return . const . (input auto . fromString <=< readFile)

dayToPreamble f d = "# " ++ formatTime defaultTimeLocale f d

timeToSubheader f t = "## " ++ formatTime defaultTimeLocale f t

main = do
  args <- parseArgsOrExit patterns =<< getArgs
  let cfile = getArg args (longOption "config")
  Config df ed edopts lb tf <- maybe (return def) decodeYamlOrDhall cfile :: IO Config
  dt@(UTCTime day time) <- getCurrentTime
  let (y, m, d) = toGregorian day
  let dir = lb </> (show y) </> (show m)
  let file = dir </> (show d) <.> "md"
  mktree $ decodeString dir
  unlessM (testfile $ decodeString file) $ appendFile file $ dayToPreamble df dt ++ "\n\n"
  appendFile file $ timeToSubheader tf dt ++ "\n\n"
  callProcess ed $ edopts ++ [file]