{-# 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\n" callProcess ed $ edopts ++ [file]