hledger/hledger/Hledger/Cli/Commands/Run.hs

{-|

The @run@ command allows you to run multiple commands via REPL or from the supplied file(s).

-}

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands.Run (
  runmode
 ,run
 ,run'
) where

import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Console.CmdArgs.Explicit as C ( Mode )
import Hledger
import Hledger.Cli.CliOptions

import Control.Concurrent.MVar
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Extra (concatMapM)

import System.Directory (doesFileExist)
import System.IO.Unsafe (unsafePerformIO)
import System.Console.Haskeline

import Safe (headMay)
import Hledger.Cli.Utils (withJournalDo)

-- | Command line options for this command.
runmode = hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Run.txt")
  (
  []
  )
  cligeneralflagsgroups1
  hiddenflags
  ([], Just $ argsFlag "[COMMANDS_FILE1 COMMANDS_FILE2 ...]")

-- | The fake run command introduced to break circular dependency
run' :: CliOpts -> Journal -> IO ()
run' _opts _j = return ()

-- | The actual run command.
run :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> CliOpts -> Journal -> IO ()
run findBuiltinCommand CliOpts{rawopts_=rawopts} j = do
  -- Add current journal to cache
  addJournalToCache j defaultJournalKey
  let args = dbg1 "args" $ listofstringopt "args" rawopts
  case args of
    [] -> runREPL findBuiltinCommand
    maybeFile:_ -> do
      -- Check if arguments could be interpreted as files.
      -- If not, assume that they are files
      isFile <- doesFileExist maybeFile
      case isFile of
        True  -> runFromFiles findBuiltinCommand args
        False -> runFromArgs  findBuiltinCommand args

runFromFiles :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runFromFiles findBuiltinCommand inputfiles = do
  dbg1IO "inputfiles" inputfiles
  -- read commands from all the inputfiles
  commands <- (flip concatMapM) inputfiles $ \f -> do
    dbg1IO "reading commands" f
    lines . T.unpack <$> T.readFile f

  forM_ commands (runCommand findBuiltinCommand . parseCommand)

runFromArgs :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runFromArgs findBuiltinCommand args = do
  -- read commands from all the inputfiles
  let commands = dbg1 "commands from args" $ splitAtElement "--" args
  forM_ commands (runCommand findBuiltinCommand)

-- When commands are passed on the command line, shell will parse them for us
-- When commands are read from file, we need to split the line into command and arguments
parseCommand :: String -> [String]
parseCommand line =
  -- # begins a comment, ignore everything after #
  takeWhile (not. ((Just '#')==) . headMay) $  words' (strip line)

runCommand :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> [String] -> IO ()
runCommand findBuiltinCommand cmdline = do
  dbg1IO "running command" cmdline
  -- # begins a comment, ignore everything after #
  case cmdline of
    "echo":args -> putStrLn $ unwords $ args
    cmdname:args ->
      case findBuiltinCommand cmdname of
      Nothing -> putStrLn $ unwords (cmdname:args)
      Just (cmdmode,cmdaction) -> do
        opts <- getHledgerCliOpts' cmdmode args
        withJournalCached opts (cmdaction opts)
    [] -> return ()

runREPL :: (String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())) -> IO ()
runREPL findBuiltinCommand = do
  putStrLn "Enter hledger commands, or 'quit' for help."
  runInputT defaultSettings loop
  where
  loop :: InputT IO ()
  loop = do
    minput <- getInputLine "% "
    case minput of
      Nothing -> return ()
      Just "quit" -> return ()
      Just "exit" -> return ()
      Just input -> do
        liftIO $ runCommand findBuiltinCommand $ parseCommand input
        loop

{-# NOINLINE journalCache #-}
journalCache :: MVar (Map.Map [String] Journal)
journalCache = unsafePerformIO $ newMVar Map.empty

-- | Key used to cache the journal given in the arguments to 'run'.
defaultJournalKey :: [String]
defaultJournalKey = ["journal specified in args of run"]

hasStdin :: [String] -> Bool
hasStdin fps = "-" `elem` fps

addJournalToCache :: Journal -> [String] -> IO ()
addJournalToCache j journalpaths = modifyMVar_ journalCache $ \cache ->
  if hasStdin $ dbg1 "addJournalToCache" journalpaths
  then return cache
  else return $ Map.insert journalpaths j cache

withJournalCached :: CliOpts -> (Journal -> IO ()) -> IO ()
withJournalCached cliopts f = do
  journalpaths <- journalFilePathFromOptsNoDefault cliopts
  -- if command does not have -f flags, use the same journal that was given to the "run" invocation
  let key = case journalpaths of
              Nothing -> defaultJournalKey
              Just paths -> NE.toList paths
  dbg1IO "withJournalCached key" key
  modifyMVar_ journalCache $ \cache ->
    if hasStdin key
    then do dbg1IO "withJournalCached skipping cache due to stdin" key
            withJournalDo cliopts f
            return cache
    else case Map.lookup key cache of
          Just journal -> do
            dbg1IO "withJournalCached using cache" key
            f journal
            return cache
          Nothing -> do
            dbg1IO "withJournalCached reading and caching journal" key
            withJournalDo cliopts $ \j -> do
              f j
              return (Map.insert key j cache)