{-|
Module      : Hoyo
Copyright   : (c) Frederick Pringle, 2023
License     : BSD-3-Clause
Maintainer  : freddyjepringle@gmail.com

hoyo is a command-line utility that lets the user save directories
as bookmarks (similar to in the browser) and easily @cd@ to them.
-}

module Hoyo (
  -- * Bookmarks
  Bookmark (..)
  , Bookmarks (..)
  , searchBookmarks
  , filterBookmarks
  , module Hoyo.Bookmark

  -- * Config
  , Config (..)
  , defaultConfig
  , setConfig
  , module Hoyo.Config
  , module Hoyo.Env

  -- * CLI commands
  , Command
  , runCommand
  , module Hoyo.Command

  -- * Utility functions
  , runHoyo
  , withFiles
  , getEnvAndRunHoyo
  , getEnvAndRunCommand
  , HoyoException (..)
  , HoyoMonad
  , modifyBookmarks
  , modifyBookmarksM
  , printStderr
  , printStdout
  , readInt
  , readBool
  , backupFile
  , assert
  , assertVerbose

  -- * Misc
  , versionString
  ) where

import Control.Monad.Except       (runExceptT)
import Control.Monad.Trans.Reader (runReaderT)

import Hoyo.Bookmark
import Hoyo.Command
import Hoyo.Config
import Hoyo.Env
import Hoyo.Internal.Types
import Hoyo.Internal.Version
import Hoyo.Utils

import System.Exit

-- | Given a hoyo 'Env', run a monadic action in IO.
runHoyo :: HoyoMonad a -> Env -> IO (Either HoyoException a)
runHoyo :: HoyoMonad a -> Env -> IO (Either HoyoException a)
runHoyo = ReaderT Env IO (Either HoyoException a)
-> Env -> IO (Either HoyoException a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT Env IO (Either HoyoException a)
 -> Env -> IO (Either HoyoException a))
-> (HoyoMonad a -> ReaderT Env IO (Either HoyoException a))
-> HoyoMonad a
-> Env
-> IO (Either HoyoException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT HoyoException (ReaderT Env IO) a
-> ReaderT Env IO (Either HoyoException a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT HoyoException (ReaderT Env IO) a
 -> ReaderT Env IO (Either HoyoException a))
-> (HoyoMonad a -> ExceptT HoyoException (ReaderT Env IO) a)
-> HoyoMonad a
-> ReaderT Env IO (Either HoyoException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HoyoMonad a -> ExceptT HoyoException (ReaderT Env IO) a
forall a. HoyoMonad a -> ExceptT HoyoException (ReaderT Env IO) a
unHoyo

failure :: HoyoException -> IO a
failure :: HoyoException -> IO a
failure HoyoException
err = do
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printStderr (Text
"Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HoyoException -> Text
formatException HoyoException
err)
  ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)

-- | @withFiles globals bFp sFp hoyo@ gets the environment saved in
-- the bookmark path (@bFp@) and the config path (@sFp@), applies the global
-- options and overrides in @globals@, and runs @hoyo@, returning either
-- the result or an error message.
withFiles :: GlobalOptions -> FilePath -> FilePath -> HoyoMonad a -> IO (Either HoyoException a)
withFiles :: GlobalOptions
-> FilePath
-> FilePath
-> HoyoMonad a
-> IO (Either HoyoException a)
withFiles GlobalOptions
globals FilePath
bFp FilePath
sFp HoyoMonad a
hoyo =
  FilePath -> FilePath -> IO (Either HoyoException Env)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> FilePath -> m (Either HoyoException Env)
getEnv FilePath
bFp FilePath
sFp IO (Either HoyoException Env)
-> (Either HoyoException Env -> IO (Either HoyoException a))
-> IO (Either HoyoException a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HoyoException
err  -> HoyoException -> IO (Either HoyoException a)
forall a. HoyoException -> IO a
failure HoyoException
err
    Right Env
env -> HoyoMonad a -> Env -> IO (Either HoyoException a)
forall a. HoyoMonad a -> Env -> IO (Either HoyoException a)
runHoyo HoyoMonad a
hoyo (Env -> IO (Either HoyoException a))
-> Env -> IO (Either HoyoException a)
forall a b. (a -> b) -> a -> b
$ OverrideOptions -> Env -> Env
overrideEnv (GlobalOptions -> OverrideOptions
overrides GlobalOptions
globals) Env
env

-- | @getEnvAndRunHoyo globals hoyo bFp sFp@ gets the environment saved in
-- the bookmark path (@bFp@) and the config path (@sFp@), applies the global
-- options and overrides in @globals@, and runs @hoyo@, either printing an error
-- message or discarding the result.
getEnvAndRunHoyo :: GlobalOptions -> HoyoMonad a -> FilePath -> FilePath -> IO a
getEnvAndRunHoyo :: GlobalOptions -> HoyoMonad a -> FilePath -> FilePath -> IO a
getEnvAndRunHoyo GlobalOptions
globals HoyoMonad a
hoyo FilePath
bFp FilePath
sFp = GlobalOptions
-> FilePath
-> FilePath
-> HoyoMonad a
-> IO (Either HoyoException a)
forall a.
GlobalOptions
-> FilePath
-> FilePath
-> HoyoMonad a
-> IO (Either HoyoException a)
withFiles GlobalOptions
globals FilePath
bFp FilePath
sFp HoyoMonad a
hoyo IO (Either HoyoException a)
-> (Either HoyoException a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left HoyoException
err  -> HoyoException -> IO a
forall a. HoyoException -> IO a
failure HoyoException
err
  Right a
res -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | @getEnvAndRunHoyo opts bFp sFp@ gets the environment saved in
-- the bookmark path (@bFp@) and the config path (@sFp@), and runs the command
-- specified by @opts@.
getEnvAndRunCommand :: Options -> FilePath -> FilePath -> IO ()
getEnvAndRunCommand :: Options -> FilePath -> FilePath -> IO ()
getEnvAndRunCommand (Options Command
cmd GlobalOptions
globals) FilePath
bFp FilePath
sFp = case Command
cmd of
  Check CheckOptions
opts -> CheckOptions -> FilePath -> FilePath -> IO ()
runCheck CheckOptions
opts FilePath
bFp FilePath
sFp
  Command
otherCmd   -> GlobalOptions -> HoyoMonad () -> FilePath -> FilePath -> IO ()
forall a.
GlobalOptions -> HoyoMonad a -> FilePath -> FilePath -> IO a
getEnvAndRunHoyo GlobalOptions
globals (Command -> HoyoMonad ()
runCommand Command
otherCmd) FilePath
bFp FilePath
sFp