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

Utility functions used by all the main Hoyo.* modules.
-}

{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE GADTs          #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes     #-}

module Hoyo.Utils (
  -- * Lenses for ConfigValue
    cfgBool
  , cfgDefaultBookmark
  , cfgCommand
  , cfgList
  , cfgMaybe

  -- * Lenses for Config
  , failOnError
  , displayCreationTime
  , enableClearing
  , enableReset
  , backupBeforeClear
  , defaultBookmarks
  , defaultCommand

  -- * Utility functions
  , asks'
  , assert
  , assertVerbose
  , maximumDefault
  , catchIOException

  -- ** Backups
  , backupFile

  -- ** Parsing functions
  , readBool
  , readInt

  -- ** Printing functions
  , printStdout
  , printStderr
  , pageLines

  -- ** Formatting functions
  , formatArgs
  , formatCommand
  , formatBookmark
  , formatBookmarks
  , formatConfigValue
  , formatOptions
  , formatException
  , tshow
  , anyCfgValToJson
  , bookmarksToJSON
  ) where

{- HLINT ignore "Use list comprehension" -}

import           Control.Applicative
import           Control.Exception          (IOException, bracket_)
import           Control.Monad              (unless, when)
import           Control.Monad.Except
                 ( MonadError (..)
                 , liftEither
                 , throwError
                 )
import           Control.Monad.IO.Class
import           Control.Monad.Reader.Class (MonadReader, asks)

import           Data.Bifunctor             (bimap, first)
import           Data.Foldable              (toList)
import           Data.Maybe
import qualified Data.Text                  as T
import qualified Data.Text.IO               as T
import           Data.Time

import           Hoyo.Internal.Types

import           Lens.Micro
import           Lens.Micro.Extras

import           System.Console.ANSI        hiding (Reset)
import           System.Directory
import           System.IO
import           System.Pager

import           Text.JSON
import           Text.Read                  (readEither)

import qualified Toml.Parser.Core           as Toml
                 ( eof
                 , errorBundlePretty
                 , parse
                 )
import qualified Toml.Parser.Value          as Toml


-----------------------------------------
-- getters and setter for ConfigValue

-- | A lens into a boolean config value.
cfgBool :: Lens' (ConfigValue 'TBool) Bool
cfgBool :: (Bool -> f Bool) -> ConfigValue 'TBool -> f (ConfigValue 'TBool)
cfgBool = (ConfigValue 'TBool -> Bool)
-> (ConfigValue 'TBool -> Bool -> ConfigValue 'TBool)
-> Lens (ConfigValue 'TBool) (ConfigValue 'TBool) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConfigValue 'TBool -> Bool
getBool ConfigValue 'TBool -> Bool -> ConfigValue 'TBool
setBool
  where
    getBool :: ConfigValue 'TBool -> Bool
    getBool :: ConfigValue 'TBool -> Bool
getBool (BoolV Bool
bool) = Bool
bool

    setBool :: ConfigValue 'TBool -> Bool -> ConfigValue 'TBool
    setBool :: ConfigValue 'TBool -> Bool -> ConfigValue 'TBool
setBool ConfigValue 'TBool
_ = Bool -> ConfigValue 'TBool
BoolV

-- | A lens into a default bookmark config value.
cfgDefaultBookmark :: Lens' (ConfigValue 'TDefaultBookmark) DefaultBookmark
cfgDefaultBookmark :: (DefaultBookmark -> f DefaultBookmark)
-> ConfigValue 'TDefaultBookmark
-> f (ConfigValue 'TDefaultBookmark)
cfgDefaultBookmark = (ConfigValue 'TDefaultBookmark -> DefaultBookmark)
-> (ConfigValue 'TDefaultBookmark
    -> DefaultBookmark -> ConfigValue 'TDefaultBookmark)
-> Lens
     (ConfigValue 'TDefaultBookmark)
     (ConfigValue 'TDefaultBookmark)
     DefaultBookmark
     DefaultBookmark
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConfigValue 'TDefaultBookmark -> DefaultBookmark
getDefaultBookmark ConfigValue 'TDefaultBookmark
-> DefaultBookmark -> ConfigValue 'TDefaultBookmark
setDefaultBookmark
  where
    getDefaultBookmark :: ConfigValue 'TDefaultBookmark -> DefaultBookmark
    getDefaultBookmark :: ConfigValue 'TDefaultBookmark -> DefaultBookmark
getDefaultBookmark (DefaultBookmarkV DefaultBookmark
bm) = DefaultBookmark
bm

    setDefaultBookmark :: ConfigValue 'TDefaultBookmark -> DefaultBookmark -> ConfigValue 'TDefaultBookmark
    setDefaultBookmark :: ConfigValue 'TDefaultBookmark
-> DefaultBookmark -> ConfigValue 'TDefaultBookmark
setDefaultBookmark ConfigValue 'TDefaultBookmark
_ = DefaultBookmark -> ConfigValue 'TDefaultBookmark
DefaultBookmarkV

-- | A lens into a command config value.
cfgCommand :: Lens' (ConfigValue 'TCommand) Command
cfgCommand :: (Command -> f Command)
-> ConfigValue 'TCommand -> f (ConfigValue 'TCommand)
cfgCommand = (ConfigValue 'TCommand -> Command)
-> (ConfigValue 'TCommand -> Command -> ConfigValue 'TCommand)
-> Lens
     (ConfigValue 'TCommand) (ConfigValue 'TCommand) Command Command
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConfigValue 'TCommand -> Command
getCommand ConfigValue 'TCommand -> Command -> ConfigValue 'TCommand
setCommand
  where
    getCommand :: ConfigValue 'TCommand -> Command
    getCommand :: ConfigValue 'TCommand -> Command
getCommand (CommandV Command
t) = Command
t

    setCommand :: ConfigValue 'TCommand -> Command -> ConfigValue 'TCommand
    setCommand :: ConfigValue 'TCommand -> Command -> ConfigValue 'TCommand
setCommand ConfigValue 'TCommand
_ = Command -> ConfigValue 'TCommand
CommandV

-- | A lens into a list config value.
cfgList :: Lens' (ConfigValue ('TList t)) [ConfigValue t]
cfgList :: ([ConfigValue t] -> f [ConfigValue t])
-> ConfigValue ('TList t) -> f (ConfigValue ('TList t))
cfgList = (ConfigValue ('TList t) -> [ConfigValue t])
-> (ConfigValue ('TList t)
    -> [ConfigValue t] -> ConfigValue ('TList t))
-> Lens
     (ConfigValue ('TList t))
     (ConfigValue ('TList t))
     [ConfigValue t]
     [ConfigValue t]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConfigValue ('TList t) -> [ConfigValue t]
forall (t :: ConfigValueType).
ConfigValue ('TList t) -> [ConfigValue t]
getList ConfigValue ('TList t) -> [ConfigValue t] -> ConfigValue ('TList t)
forall (t :: ConfigValueType).
ConfigValue ('TList t) -> [ConfigValue t] -> ConfigValue ('TList t)
setList
  where
    getList :: ConfigValue ('TList t) -> [ConfigValue t]
    getList :: ConfigValue ('TList t) -> [ConfigValue t]
getList (ListOfV [ConfigValue a]
xs) = [ConfigValue t]
[ConfigValue a]
xs

    setList :: ConfigValue ('TList t) -> [ConfigValue t] -> ConfigValue ('TList t)
    setList :: ConfigValue ('TList t) -> [ConfigValue t] -> ConfigValue ('TList t)
setList ConfigValue ('TList t)
_ = [ConfigValue t] -> ConfigValue ('TList t)
forall (a :: ConfigValueType).
[ConfigValue a] -> ConfigValue ('TList a)
ListOfV

-- | A lens into an optional config value.
cfgMaybe :: Lens' (ConfigValue ('TMaybe t)) (Maybe (ConfigValue t))
cfgMaybe :: (Maybe (ConfigValue t) -> f (Maybe (ConfigValue t)))
-> ConfigValue ('TMaybe t) -> f (ConfigValue ('TMaybe t))
cfgMaybe = (ConfigValue ('TMaybe t) -> Maybe (ConfigValue t))
-> (ConfigValue ('TMaybe t)
    -> Maybe (ConfigValue t) -> ConfigValue ('TMaybe t))
-> Lens
     (ConfigValue ('TMaybe t))
     (ConfigValue ('TMaybe t))
     (Maybe (ConfigValue t))
     (Maybe (ConfigValue t))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConfigValue ('TMaybe t) -> Maybe (ConfigValue t)
forall (t :: ConfigValueType).
ConfigValue ('TMaybe t) -> Maybe (ConfigValue t)
getMaybe ConfigValue ('TMaybe t)
-> Maybe (ConfigValue t) -> ConfigValue ('TMaybe t)
forall (t :: ConfigValueType).
ConfigValue ('TMaybe t)
-> Maybe (ConfigValue t) -> ConfigValue ('TMaybe t)
setMaybe
  where
    getMaybe :: ConfigValue ('TMaybe t) -> Maybe (ConfigValue t)
    getMaybe :: ConfigValue ('TMaybe t) -> Maybe (ConfigValue t)
getMaybe (MaybeV Maybe (ConfigValue a)
val) = Maybe (ConfigValue t)
Maybe (ConfigValue a)
val

    setMaybe :: ConfigValue ('TMaybe t) -> Maybe (ConfigValue t) -> ConfigValue ('TMaybe t)
    setMaybe :: ConfigValue ('TMaybe t)
-> Maybe (ConfigValue t) -> ConfigValue ('TMaybe t)
setMaybe ConfigValue ('TMaybe t)
_ = Maybe (ConfigValue t) -> ConfigValue ('TMaybe t)
forall (a :: ConfigValueType).
Maybe (ConfigValue a) -> ConfigValue ('TMaybe a)
MaybeV

-----------------------------------------
-- Lenses for Config

failOnError :: Lens' Config Bool
failOnError :: (Bool -> f Bool) -> Config -> f Config
failOnError = (ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> Config -> f Config
Lens' Config (ConfigValue 'TBool)
__failOnError ((ConfigValue 'TBool -> f (ConfigValue 'TBool))
 -> Config -> f Config)
-> ((Bool -> f Bool)
    -> ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> (Bool -> f Bool)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ConfigValue 'TBool -> f (ConfigValue 'TBool)
Lens (ConfigValue 'TBool) (ConfigValue 'TBool) Bool Bool
cfgBool

displayCreationTime :: Lens' Config Bool
displayCreationTime :: (Bool -> f Bool) -> Config -> f Config
displayCreationTime = (ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> Config -> f Config
Lens' Config (ConfigValue 'TBool)
__displayCreationTime ((ConfigValue 'TBool -> f (ConfigValue 'TBool))
 -> Config -> f Config)
-> ((Bool -> f Bool)
    -> ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> (Bool -> f Bool)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ConfigValue 'TBool -> f (ConfigValue 'TBool)
Lens (ConfigValue 'TBool) (ConfigValue 'TBool) Bool Bool
cfgBool

enableClearing :: Lens' Config Bool
enableClearing :: (Bool -> f Bool) -> Config -> f Config
enableClearing = (ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> Config -> f Config
Lens' Config (ConfigValue 'TBool)
__enableClearing ((ConfigValue 'TBool -> f (ConfigValue 'TBool))
 -> Config -> f Config)
-> ((Bool -> f Bool)
    -> ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> (Bool -> f Bool)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ConfigValue 'TBool -> f (ConfigValue 'TBool)
Lens (ConfigValue 'TBool) (ConfigValue 'TBool) Bool Bool
cfgBool

enableReset :: Lens' Config Bool
enableReset :: (Bool -> f Bool) -> Config -> f Config
enableReset = (ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> Config -> f Config
Lens' Config (ConfigValue 'TBool)
__enableReset ((ConfigValue 'TBool -> f (ConfigValue 'TBool))
 -> Config -> f Config)
-> ((Bool -> f Bool)
    -> ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> (Bool -> f Bool)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ConfigValue 'TBool -> f (ConfigValue 'TBool)
Lens (ConfigValue 'TBool) (ConfigValue 'TBool) Bool Bool
cfgBool

backupBeforeClear :: Lens' Config Bool
backupBeforeClear :: (Bool -> f Bool) -> Config -> f Config
backupBeforeClear = (ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> Config -> f Config
Lens' Config (ConfigValue 'TBool)
__backupBeforeClear ((ConfigValue 'TBool -> f (ConfigValue 'TBool))
 -> Config -> f Config)
-> ((Bool -> f Bool)
    -> ConfigValue 'TBool -> f (ConfigValue 'TBool))
-> (Bool -> f Bool)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> ConfigValue 'TBool -> f (ConfigValue 'TBool)
Lens (ConfigValue 'TBool) (ConfigValue 'TBool) Bool Bool
cfgBool

liftLensToList :: Lens' a b -> Lens' [a] [b]
liftLensToList :: Lens' a b -> Lens' [a] [b]
liftLensToList Lens' a b
l = (ZipList a -> f (ZipList a)) -> [a] -> f [a]
forall a b. (ZipList a -> f b) -> [a] -> f [a]
zipList' ((ZipList a -> f (ZipList a)) -> [a] -> f [a])
-> (([b] -> f [b]) -> ZipList a -> f (ZipList a))
-> ([b] -> f [b])
-> [a]
-> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' a b -> Lens' (ZipList a) (ZipList b)
forall (g :: * -> *) a b.
Applicative g =>
Lens' a b -> Lens' (g a) (g b)
liftLens Lens' a b
l ((ZipList b -> f (ZipList b)) -> ZipList a -> f (ZipList a))
-> (([b] -> f [b]) -> ZipList b -> f (ZipList b))
-> ([b] -> f [b])
-> ZipList a
-> f (ZipList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> f [b]) -> ZipList b -> f (ZipList b)
forall a b. ([a] -> f b) -> ZipList a -> f (ZipList a)
zipList
  where
    zipList :: ([a] -> f b) -> ZipList a -> f (ZipList a)
zipList = (ZipList a -> [a])
-> (ZipList a -> b -> ZipList a)
-> Lens (ZipList a) (ZipList a) [a] b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ZipList a -> [a]
forall a. ZipList a -> [a]
getZipList ZipList a -> b -> ZipList a
forall a b. a -> b -> a
const
    zipList' :: (ZipList a -> f b) -> [a] -> f [a]
zipList' = ([a] -> ZipList a)
-> ([a] -> b -> [a]) -> Lens [a] [a] (ZipList a) b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList [a] -> b -> [a]
forall a b. a -> b -> a
const

liftLens :: Applicative g => Lens' a b -> Lens' (g a) (g b)
liftLens :: Lens' a b -> Lens' (g a) (g b)
liftLens Lens' a b
l = (g a -> g b) -> (g a -> g b -> g a) -> Lens' (g a) (g b)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting b a b -> a -> b
forall a s. Getting a s a -> s -> a
view Getting b a b
Lens' a b
l)) (\g a
ga g b
gb -> ASetter a a b b -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a b b
Lens' a b
l (b -> a -> a) -> g b -> g (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g b
gb g (a -> a) -> g a -> g a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a
ga)

defaultBookmarks :: Lens' Config [DefaultBookmark]
defaultBookmarks :: ([DefaultBookmark] -> f [DefaultBookmark]) -> Config -> f Config
defaultBookmarks = (ConfigValue ('TList 'TDefaultBookmark)
 -> f (ConfigValue ('TList 'TDefaultBookmark)))
-> Config -> f Config
Lens' Config (ConfigValue ('TList 'TDefaultBookmark))
__defaultBookmarks ((ConfigValue ('TList 'TDefaultBookmark)
  -> f (ConfigValue ('TList 'TDefaultBookmark)))
 -> Config -> f Config)
-> (([DefaultBookmark] -> f [DefaultBookmark])
    -> ConfigValue ('TList 'TDefaultBookmark)
    -> f (ConfigValue ('TList 'TDefaultBookmark)))
-> ([DefaultBookmark] -> f [DefaultBookmark])
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ConfigValue 'TDefaultBookmark]
 -> f [ConfigValue 'TDefaultBookmark])
-> ConfigValue ('TList 'TDefaultBookmark)
-> f (ConfigValue ('TList 'TDefaultBookmark))
forall (t :: ConfigValueType).
Lens' (ConfigValue ('TList t)) [ConfigValue t]
cfgList (([ConfigValue 'TDefaultBookmark]
  -> f [ConfigValue 'TDefaultBookmark])
 -> ConfigValue ('TList 'TDefaultBookmark)
 -> f (ConfigValue ('TList 'TDefaultBookmark)))
-> (([DefaultBookmark] -> f [DefaultBookmark])
    -> [ConfigValue 'TDefaultBookmark]
    -> f [ConfigValue 'TDefaultBookmark])
-> ([DefaultBookmark] -> f [DefaultBookmark])
-> ConfigValue ('TList 'TDefaultBookmark)
-> f (ConfigValue ('TList 'TDefaultBookmark))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens
  (ConfigValue 'TDefaultBookmark)
  (ConfigValue 'TDefaultBookmark)
  DefaultBookmark
  DefaultBookmark
-> Lens' [ConfigValue 'TDefaultBookmark] [DefaultBookmark]
forall a b. Lens' a b -> Lens' [a] [b]
liftLensToList Lens
  (ConfigValue 'TDefaultBookmark)
  (ConfigValue 'TDefaultBookmark)
  DefaultBookmark
  DefaultBookmark
cfgDefaultBookmark

defaultCommand :: Lens' Config (Maybe Command)
defaultCommand :: (Maybe Command -> f (Maybe Command)) -> Config -> f Config
defaultCommand = (ConfigValue ('TMaybe 'TCommand)
 -> f (ConfigValue ('TMaybe 'TCommand)))
-> Config -> f Config
Lens' Config (ConfigValue ('TMaybe 'TCommand))
__defaultCommand ((ConfigValue ('TMaybe 'TCommand)
  -> f (ConfigValue ('TMaybe 'TCommand)))
 -> Config -> f Config)
-> ((Maybe Command -> f (Maybe Command))
    -> ConfigValue ('TMaybe 'TCommand)
    -> f (ConfigValue ('TMaybe 'TCommand)))
-> (Maybe Command -> f (Maybe Command))
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ConfigValue 'TCommand)
 -> f (Maybe (ConfigValue 'TCommand)))
-> ConfigValue ('TMaybe 'TCommand)
-> f (ConfigValue ('TMaybe 'TCommand))
forall (t :: ConfigValueType).
Lens' (ConfigValue ('TMaybe t)) (Maybe (ConfigValue t))
cfgMaybe ((Maybe (ConfigValue 'TCommand)
  -> f (Maybe (ConfigValue 'TCommand)))
 -> ConfigValue ('TMaybe 'TCommand)
 -> f (ConfigValue ('TMaybe 'TCommand)))
-> ((Maybe Command -> f (Maybe Command))
    -> Maybe (ConfigValue 'TCommand)
    -> f (Maybe (ConfigValue 'TCommand)))
-> (Maybe Command -> f (Maybe Command))
-> ConfigValue ('TMaybe 'TCommand)
-> f (ConfigValue ('TMaybe 'TCommand))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens
  (ConfigValue 'TCommand) (ConfigValue 'TCommand) Command Command
-> Lens' (Maybe (ConfigValue 'TCommand)) (Maybe Command)
forall (g :: * -> *) a b.
Applicative g =>
Lens' a b -> Lens' (g a) (g b)
liftLens Lens
  (ConfigValue 'TCommand) (ConfigValue 'TCommand) Command Command
cfgCommand

-----------------------------------------

-- | A version of the lens "use" function for 'MonadReader'.
asks' :: MonadReader a m => SimpleGetter a b -> m b
asks' :: SimpleGetter a b -> m b
asks' = (a -> b) -> m b
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((a -> b) -> m b)
-> (Getting b a b -> a -> b) -> Getting b a b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting b a b -> a -> b
forall a s. Getting a s a -> s -> a
view

-- | Take the maximum of a list, with a default value if the list is empty.
maximumDefault :: Ord a => a -> [a] -> a
maximumDefault :: a -> [a] -> a
maximumDefault a
def [] = a
def
maximumDefault a
_ [a]
xs   = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs

-- | Throw an error if a check fails.
assert :: HoyoException -> HoyoMonad Bool -> HoyoMonad ()
assert :: HoyoException -> HoyoMonad Bool -> HoyoMonad ()
assert HoyoException
err HoyoMonad Bool
check = do
  Bool
res <- HoyoMonad Bool
check
  Bool -> HoyoMonad () -> HoyoMonad ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (HoyoMonad () -> HoyoMonad ()) -> HoyoMonad () -> HoyoMonad ()
forall a b. (a -> b) -> a -> b
$ HoyoException -> HoyoMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError HoyoException
err

-- | Throw an error if a check fails AND the "fail_on_error" flag is set.
assertVerbose :: HoyoException -> HoyoMonad Bool -> HoyoMonad Bool
assertVerbose :: HoyoException -> HoyoMonad Bool -> HoyoMonad Bool
assertVerbose HoyoException
err HoyoMonad Bool
check = do
  Bool
shouldFail <- SimpleGetter Env Bool -> HoyoMonad Bool
forall a (m :: * -> *) b.
MonadReader a m =>
SimpleGetter a b -> m b
asks' ((Config -> Const r Config) -> Env -> Const r Env
Lens' Env Config
config ((Config -> Const r Config) -> Env -> Const r Env)
-> ((Bool -> Const r Bool) -> Config -> Const r Config)
-> (Bool -> Const r Bool)
-> Env
-> Const r Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const r Bool) -> Config -> Const r Config
Lens' Config Bool
failOnError)
  Bool
res <- HoyoMonad Bool
check
  Bool -> HoyoMonad () -> HoyoMonad ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shouldFail Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
res) (HoyoMonad () -> HoyoMonad ()) -> HoyoMonad () -> HoyoMonad ()
forall a b. (a -> b) -> a -> b
$ HoyoException -> HoyoMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError HoyoException
err
  Bool -> HoyoMonad Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
res

-- | Given a file name and an extension, try to find a suitable path for
-- backing up that file. Used by 'backupFile'.
getBackupFile :: (MonadIO m, MonadError HoyoException m) => FilePath -> String -> m FilePath
getBackupFile :: FilePath -> FilePath -> m FilePath
getBackupFile FilePath
fp FilePath
ext = do
  Bool
ex <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fp
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ex (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HoyoException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HoyoException -> m ()) -> HoyoException -> m ()
forall a b. (a -> b) -> a -> b
$ FileSystemException -> HoyoException
FileSystemException (FileSystemException -> HoyoException)
-> FileSystemException -> HoyoException
forall a b. (a -> b) -> a -> b
$ FilePath -> FileSystemException
NoFileException FilePath
fp
  let firstTry :: FilePath
firstTry = FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ext
  Bool
firstExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
firstTry
  if Bool
firstExists
  then FilePath -> Int -> m FilePath
forall (m :: * -> *).
(MonadIO m, MonadError HoyoException m) =>
FilePath -> Int -> m FilePath
getBackupFile' FilePath
fp Int
2
  else FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
firstTry

  where
    getBackupFile' :: (MonadIO m, MonadError HoyoException m) => String -> Int -> m String
    getBackupFile' :: FilePath -> Int -> m FilePath
getBackupFile' FilePath
file' Int
n = do
      let file :: FilePath
file = FilePath
file' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ext
      Bool
fileExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
file
      if Bool
fileExists
      then FilePath -> Int -> m FilePath
forall (m :: * -> *).
(MonadIO m, MonadError HoyoException m) =>
FilePath -> Int -> m FilePath
getBackupFile' FilePath
file' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      else FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file

-- | Try to back-up a file. Used when the "backup_before_clear" option is set.
backupFile :: (MonadIO m, MonadError HoyoException m) => FilePath -> String -> m ()
backupFile :: FilePath -> FilePath -> m ()
backupFile FilePath
fp FilePath
ext = do
  FilePath
file <- FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
(MonadIO m, MonadError HoyoException m) =>
FilePath -> FilePath -> m FilePath
getBackupFile FilePath
fp FilePath
ext
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFileWithMetadata FilePath
fp FilePath
file

-- | Try to read a 'Bool'.
readBool :: MonadError HoyoException m => T.Text -> m Bool
readBool :: Text -> m Bool
readBool Text
s = Either HoyoException Bool -> m Bool
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either HoyoException Bool -> m Bool)
-> Either HoyoException Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (FilePath -> HoyoException)
-> Either FilePath Bool -> Either HoyoException Bool
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Text] -> HoyoException
ParseException ([Text] -> HoyoException)
-> (FilePath -> [Text]) -> FilePath -> HoyoException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) (
              FilePath -> Either FilePath Bool
forall a. Read a => FilePath -> Either FilePath a
readEither FilePath
sStr
                Either FilePath Bool
-> Either FilePath Bool -> Either FilePath Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParseErrorBundle Text Void -> FilePath)
-> Either (ParseErrorBundle Text Void) Bool -> Either FilePath Bool
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
Toml.errorBundlePretty (Parsec Void Text Bool
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Bool
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
Toml.parse (Parsec Void Text Bool
Toml.boolP Parsec Void Text Bool
-> ParsecT Void Text Identity () -> Parsec Void Text Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Toml.eof) FilePath
"" Text
s)
                Either FilePath Bool
-> Either FilePath Bool -> Either FilePath Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Either FilePath Bool
forall a b. a -> Either a b
Left (FilePath
"Couldn't parse bool: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
sStr)
              )
  where sStr :: FilePath
sStr = Text -> FilePath
T.unpack Text
s

-- | Try to read an 'Int'.
readInt :: MonadError HoyoException m => T.Text -> m Int
readInt :: Text -> m Int
readInt Text
s = Either HoyoException Int -> m Int
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either HoyoException Int -> m Int)
-> Either HoyoException Int -> m Int
forall a b. (a -> b) -> a -> b
$ (FilePath -> HoyoException)
-> Either FilePath Int -> Either HoyoException Int
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Text] -> HoyoException
ParseException ([Text] -> HoyoException)
-> (FilePath -> [Text]) -> FilePath -> HoyoException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) (
              FilePath -> Either FilePath Int
forall a. Read a => FilePath -> Either FilePath a
readEither FilePath
sStr
                Either FilePath Int -> Either FilePath Int -> Either FilePath Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParseErrorBundle Text Void -> FilePath)
-> (Integer -> Int)
-> Either (ParseErrorBundle Text Void) Integer
-> Either FilePath Int
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
Toml.errorBundlePretty Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parsec Void Text Integer
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Integer
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
Toml.parse (Parsec Void Text Integer
Toml.integerP Parsec Void Text Integer
-> ParsecT Void Text Identity () -> Parsec Void Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Toml.eof) FilePath
"" Text
s)
                Either FilePath Int -> Either FilePath Int -> Either FilePath Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Either FilePath Int
forall a b. a -> Either a b
Left (FilePath
"Couldn't parse integer: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
sStr)
              )
  where sStr :: FilePath
sStr = Text -> FilePath
T.unpack Text
s

-- | Print to stderr.
printStderr :: MonadIO m => T.Text -> m ()
printStderr :: Text -> m ()
printStderr Text
msg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO () -> IO ()
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
makeRed IO ()
resetColour (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
msg
  where
    makeRed :: IO ()
makeRed = Handle -> [SGR] -> IO ()
hSetSGR Handle
stderr [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red]
    resetColour :: IO ()
resetColour = do
      Handle -> [SGR] -> IO ()
hSetSGR Handle
stderr []
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
""

-- | Print to stdout.
printStdout :: MonadIO m => T.Text -> m ()
printStdout :: Text -> m ()
printStdout = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStrLn

-- | Page lines if larger than one page and if the output device is a terminal.
-- Otherwise, print.
pageLines :: MonadIO m => [T.Text] -> m ()
pageLines :: [Text] -> m ()
pageLines [Text]
ts = do
  let t :: Text
t = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ts
  Bool
isTTY <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsTerminalDevice Handle
stdin
  if Bool
isTTY
  then IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
printOrPage (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
  else Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printStdout Text
t

-- | Format a 'Bookmark'. Used for the "list" command and error reporting
-- during other commands.
--
-- @formatBookmark displayTime numberWidth bm@ returns a pretty representation
-- of @bm@, optionally showing the creation time, and padding the index and
-- directory to a certain width.
formatBookmark :: Bool -> Int -> Int -> Bookmark -> T.Text
formatBookmark :: Bool -> Int -> Int -> Bookmark -> Text
formatBookmark Bool
shouldDisplayTime Int
indexWidth Int
direcWidth (Bookmark FilePath
dir Int
idx ZonedTime
zTime Maybe Text
mbName) =
  let num :: Text
num = Int -> Char -> Text -> Text
T.justifyRight Int
indexWidth Char
' ' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
idx
      dirStr :: Text
dirStr = Int -> Char -> Text -> Text
T.justifyLeft Int
direcWidth Char
' ' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
dir
      timeStr :: Text
timeStr = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> ZonedTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%D %T" ZonedTime
zTime
      d :: Text
d = case Maybe Text
mbName of Maybe Text
Nothing   -> Text
dirStr
                         Just Text
name -> Text
dirStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"  (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

  in if Bool
shouldDisplayTime
     then Text
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
timeStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d
     else Text
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d

-- | Format a list of 'Bookmark's. Used for the "list" command and error reporting
-- during other commands
--
-- @formatBookmark displayTime bms@ returns a pretty representation
-- of @bms@, optionally showing the creation time, and padding the indices to
-- line up.
formatBookmarks :: Bool -> [Bookmark] -> [T.Text]
formatBookmarks :: Bool -> [Bookmark] -> [Text]
formatBookmarks Bool
shouldDisplayTime [Bookmark]
bms = (Bookmark -> Text) -> [Bookmark] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Int -> Int -> Bookmark -> Text
formatBookmark Bool
shouldDisplayTime Int
indexWidth Int
direcWidth) [Bookmark]
bms
  where
    indexWidth :: Int
indexWidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDefault Int
1 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Bookmark -> Int) -> [Bookmark] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> (Bookmark -> FilePath) -> Bookmark -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> (Bookmark -> Int) -> Bookmark -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int Bookmark Int -> Bookmark -> Int
forall a s. Getting a s a -> s -> a
view Getting Int Bookmark Int
Lens' Bookmark Int
bookmarkIndex) [Bookmark]
bms
    direcWidth :: Int
direcWidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDefault Int
1 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Bookmark -> Int) -> [Bookmark] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> (Bookmark -> FilePath) -> Bookmark -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting FilePath Bookmark FilePath -> Bookmark -> FilePath
forall a s. Getting a s a -> s -> a
view Getting FilePath Bookmark FilePath
Lens' Bookmark FilePath
bookmarkDirectory) [Bookmark]
bms

-- | Format a 'DefaultBookmark'. Used for the "config print" command and error reporting
-- during other commands.
--
-- @formatDefaultBookmark bm@ returns a pretty representation of @bm@.
formatDefaultBookmark :: DefaultBookmark -> T.Text
formatDefaultBookmark :: DefaultBookmark -> Text
formatDefaultBookmark (DefaultBookmark FilePath
dir Maybe Text
mbName) =
  case Maybe Text
mbName of Maybe Text
Nothing   -> FilePath -> Text
T.pack FilePath
dir
                 Just Text
name -> FilePath -> Text
T.pack FilePath
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\t(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Show a value as a 'T.Text' instead of a 'String'.
tshow :: Show a => a -> T.Text
tshow :: a -> Text
tshow = FilePath -> Text
T.pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show

-- | Format a config value. Used for the "config print" command.
formatConfigValue :: AnyConfigValue -> T.Text
formatConfigValue :: AnyConfigValue -> Text
formatConfigValue (AnyConfigValue (BoolV Bool
bool)) = Bool -> Text
forall a. Show a => a -> Text
tshow Bool
bool
formatConfigValue (AnyConfigValue (DefaultBookmarkV DefaultBookmark
bm)) = DefaultBookmark -> Text
formatDefaultBookmark DefaultBookmark
bm
formatConfigValue (AnyConfigValue (CommandV Command
t)) = Text -> Text
forall a. Show a => a -> Text
tshow (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
formatArgs ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
formatCommand Command
t
-- formatConfigValue (AnyConfigValue (CommandV t)) = tshow t
formatConfigValue (AnyConfigValue (MaybeV Maybe (ConfigValue a)
t)) = case Maybe (ConfigValue a)
t of
                                                  Maybe (ConfigValue a)
Nothing -> Text
""
                                                  Just ConfigValue a
t' -> AnyConfigValue -> Text
formatConfigValue (ConfigValue a -> AnyConfigValue
forall (t :: ConfigValueType). ConfigValue t -> AnyConfigValue
AnyConfigValue ConfigValue a
t')
formatConfigValue (AnyConfigValue (ListOfV [ConfigValue a]
xs)) = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text
"["] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (ConfigValue a -> Text) -> [ConfigValue a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ConfigValue a -> Text) -> ConfigValue a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyConfigValue -> Text
formatConfigValue (AnyConfigValue -> Text)
-> (ConfigValue a -> AnyConfigValue) -> ConfigValue a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigValue a -> AnyConfigValue
forall (t :: ConfigValueType). ConfigValue t -> AnyConfigValue
AnyConfigValue) [ConfigValue a]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"]"])

-- formatBookmarkSearchTerm :: BookmarkSearchTerm -> T.Text
-- formatBookmarkSearchTerm (SearchIndex idx) = "#" <> tshow idx
-- formatBookmarkSearchTerm (SearchName name) = name

formatSearchTerm :: BookmarkSearchTerm -> T.Text
formatSearchTerm :: BookmarkSearchTerm -> Text
formatSearchTerm (SearchIndex Int
idx) = Int -> Text
forall a. Show a => a -> Text
tshow Int
idx
formatSearchTerm (SearchName Text
name) = Text
name

formatSearchTermPretty :: BookmarkSearchTerm -> T.Text
formatSearchTermPretty :: BookmarkSearchTerm -> Text
formatSearchTermPretty (SearchIndex Int
idx) = Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
idx
formatSearchTermPretty (SearchName Text
name) = Text
name

singleton :: T.Text -> [T.Text]
singleton :: Text -> [Text]
singleton Text
t = [Text
t]

maybeSingleton :: Maybe T.Text -> [T.Text]
maybeSingleton :: Maybe Text -> [Text]
maybeSingleton = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
singleton

maybeSingletonWithPrefix :: [T.Text] -> Maybe T.Text -> [T.Text]
maybeSingletonWithPrefix :: [Text] -> Maybe Text -> [Text]
maybeSingletonWithPrefix [Text]
pref = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> [Text]
pref [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
t])

-- | Format a 'Command' in the same way it would be parsed from the command line.
formatCommand :: Command -> [T.Text]
formatCommand :: Command -> [Text]
formatCommand (Add (AddOptions FilePath
d Maybe Text
n)) = Text
"add" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: FilePath -> Text
T.pack FilePath
d Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
maybeSingleton Maybe Text
n
formatCommand (Move MoveOptions
opts) = [Text
"move", BookmarkSearchTerm -> Text
formatSearchTerm (BookmarkSearchTerm -> Text) -> BookmarkSearchTerm -> Text
forall a b. (a -> b) -> a -> b
$ MoveOptions -> BookmarkSearchTerm
moveSearch MoveOptions
opts]
formatCommand (List (ListOptions Maybe Text
n Maybe Text
d Bool
json)) = [Text
"list"]
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> Maybe Text -> [Text]
maybeSingletonWithPrefix [Text
"--name"] Maybe Text
n
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> Maybe Text -> [Text]
maybeSingletonWithPrefix [Text
"--dir"] Maybe Text
d
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (if Bool
json then [Text
"--json"] else [])
formatCommand (Clear ClearOptions
ClearOptions) = [Text
"clear"]
formatCommand (Delete DeleteOptions
opts) = [Text
"delete", BookmarkSearchTerm -> Text
formatSearchTerm (BookmarkSearchTerm -> Text) -> BookmarkSearchTerm -> Text
forall a b. (a -> b) -> a -> b
$ DeleteOptions -> BookmarkSearchTerm
deleteSearch DeleteOptions
opts]
formatCommand (Refresh RefreshOptions
RefreshOptions) = [Text
"refresh"]
formatCommand (ConfigCmd ConfigCommand
cmd) = Text
"config" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ConfigCommand -> [Text]
formatConfigCommand ConfigCommand
cmd
formatCommand (Check (CheckOptions Bool
c Bool
b)) = [Text
"check"]
                                        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (if Bool
c then [Text
"--config"] else [])
                                        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then [Text
"--bookmarks"] else [])
formatCommand (Help (HelpOptions Maybe Text
cmd)) = [Text
"help"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
cmd
formatCommand Command
DefaultCommand = []

formatConfigCommand :: ConfigCommand -> [T.Text]
formatConfigCommand :: ConfigCommand -> [Text]
formatConfigCommand (Print (ConfigPrintOptions Bool
json)) = [Text
"print"]
                                                     [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (if Bool
json then [Text
"--json"] else [])
formatConfigCommand (Reset ConfigResetOptions
ConfigResetOptions) = [Text
"reset"]
formatConfigCommand (Set ConfigSetOptions
opts) = [Text
"set"
                                , ConfigSetOptions -> Text
setKey ConfigSetOptions
opts
                                , ConfigSetOptions -> Text
setValue ConfigSetOptions
opts
                                ]
formatConfigCommand (AddDefaultBookmark (ConfigAddDefaultOptions FilePath
d Maybe Text
n))
  = Text
"add-default" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: FilePath -> Text
T.pack FilePath
d Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
maybeSingleton Maybe Text
n

formatGlobals :: GlobalOptions -> [T.Text]
formatGlobals :: GlobalOptions -> [Text]
formatGlobals (GlobalOptions Maybe FilePath
c Maybe FilePath
d OverrideOptions
o) = [Text] -> Maybe Text -> [Text]
maybeSingletonWithPrefix [Text
"--config-file"] (FilePath -> Text
T.pack (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
c)
                                   [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> Maybe Text -> [Text]
maybeSingletonWithPrefix [Text
"--bookmarks-file"] (FilePath -> Text
T.pack (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
d)
                                   [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> OverrideOptions -> [Text]
formatOverrides OverrideOptions
o

formatOverrides :: OverrideOptions -> [T.Text]
formatOverrides :: OverrideOptions -> [Text]
formatOverrides (OverrideOptions MaybeOverride
f MaybeOverride
t MaybeOverride
c MaybeOverride
r MaybeOverride
b) = Text -> Text -> MaybeOverride -> [Text]
formatOverride Text
"fail" Text
"nofail" MaybeOverride
f
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> MaybeOverride -> [Text]
formatOverride Text
"time" Text
"notime" MaybeOverride
t
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> MaybeOverride -> [Text]
formatOverride Text
"enable-clear" Text
"disable-clear" MaybeOverride
c
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> MaybeOverride -> [Text]
formatOverride Text
"enable-reset" Text
"disable-reset" MaybeOverride
r
                                           [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> MaybeOverride -> [Text]
formatOverride Text
"backup-before-clear" Text
"no-backup-before-clear" MaybeOverride
b

formatOverride :: T.Text -> T.Text -> MaybeOverride -> [T.Text]
formatOverride :: Text -> Text -> MaybeOverride -> [Text]
formatOverride Text
_ Text
no MaybeOverride
OverrideFalse = [Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
no]
formatOverride Text
yes Text
_ MaybeOverride
OverrideTrue = [Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yes]
formatOverride Text
_ Text
_ MaybeOverride
NoOverride     = []
formatOverride Text
yes Text
no MaybeOverride
Conflict    = [Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
no, Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yes]

-- | Format an 'Options' object in the same way it would be parsed from the command line.
formatOptions :: Options -> [T.Text]
formatOptions :: Options -> [Text]
formatOptions (Options Command
c GlobalOptions
g) = Command -> [Text]
formatCommand Command
c [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> GlobalOptions -> [Text]
formatGlobals GlobalOptions
g

-- | Format a list of arguments into a single 'T.Text', enclosing multi-word arguments in quotes.
formatArgs :: [T.Text] -> T.Text
formatArgs :: [Text] -> Text
formatArgs = [Text] -> Text
T.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quoteStrings
  where quoteStrings :: T.Text -> T.Text
        quoteStrings :: Text -> Text
quoteStrings Text
s | Char
' ' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> FilePath
T.unpack Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | Bool
otherwise  = Text
s

-- | Convert a list of 'Bookmark's to a JSON value. Used in `hoyo list --json`.
bookmarksToJSON :: Bool -> [Bookmark] -> JSValue
bookmarksToJSON :: Bool -> [Bookmark] -> JSValue
bookmarksToJSON Bool
displayTime [Bookmark]
bms =
  let nameObj :: Maybe Text -> JSValue
nameObj = JSValue -> (Text -> JSValue) -> Maybe Text -> JSValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JSValue
JSNull (JSString -> JSValue
JSString (JSString -> JSValue) -> (Text -> JSString) -> Text -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> JSString
toJSString (FilePath -> JSString) -> (Text -> FilePath) -> Text -> JSString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
      bmToObj :: Bookmark -> JSValue
bmToObj (Bookmark FilePath
dir Int
idx ZonedTime
time Maybe Text
mbName) = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(FilePath, JSValue)] -> JSObject JSValue
forall a. [(FilePath, a)] -> JSObject a
toJSObject ([(FilePath, JSValue)] -> JSObject JSValue)
-> [(FilePath, JSValue)] -> JSObject JSValue
forall a b. (a -> b) -> a -> b
$ [
          (FilePath
"index", Bool -> Rational -> JSValue
JSRational Bool
False (Rational -> JSValue) -> Rational -> JSValue
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a. Real a => a -> Rational
toRational Int
idx)
        , (FilePath
"directory", JSString -> JSValue
JSString (JSString -> JSValue) -> JSString -> JSValue
forall a b. (a -> b) -> a -> b
$ FilePath -> JSString
toJSString FilePath
dir)
        , (FilePath
"name", Maybe Text -> JSValue
nameObj Maybe Text
mbName)
        ]
        [(FilePath, JSValue)]
-> [(FilePath, JSValue)] -> [(FilePath, JSValue)]
forall a. Semigroup a => a -> a -> a
<> [(FilePath
"creation_time", JSString -> JSValue
JSString (JSString -> JSValue) -> JSString -> JSValue
forall a b. (a -> b) -> a -> b
$ FilePath -> JSString
toJSString (FilePath -> JSString) -> FilePath -> JSString
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> ZonedTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%c" ZonedTime
time)
            | Bool
displayTime]
      arr :: JSValue
arr = [JSValue] -> JSValue
JSArray ([JSValue] -> JSValue) -> [JSValue] -> JSValue
forall a b. (a -> b) -> a -> b
$ (Bookmark -> JSValue) -> [Bookmark] -> [JSValue]
forall a b. (a -> b) -> [a] -> [b]
map Bookmark -> JSValue
bmToObj [Bookmark]
bms
  in JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(FilePath, JSValue)] -> JSObject JSValue
forall a. [(FilePath, a)] -> JSObject a
toJSObject [(FilePath
"bookmarks", JSValue
arr)]

cfgValToJson :: forall (t :: ConfigValueType). ConfigValue t -> JSValue
cfgValToJson :: ConfigValue t -> JSValue
cfgValToJson (BoolV Bool
b) = Bool -> JSValue
JSBool Bool
b
cfgValToJson (DefaultBookmarkV (DefaultBookmark FilePath
dir Maybe Text
mbName)) =
  JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(FilePath, JSValue)] -> JSObject JSValue
forall a. [(FilePath, a)] -> JSObject a
toJSObject [
      (FilePath
"directory", JSString -> JSValue
JSString (JSString -> JSValue) -> JSString -> JSValue
forall a b. (a -> b) -> a -> b
$ FilePath -> JSString
toJSString FilePath
dir)
    , (FilePath
"name", case Maybe Text
mbName of Maybe Text
Nothing   -> JSValue
JSNull
                              Just Text
name -> JSString -> JSValue
JSString (JSString -> JSValue) -> JSString -> JSValue
forall a b. (a -> b) -> a -> b
$ FilePath -> JSString
toJSString (FilePath -> JSString) -> FilePath -> JSString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
name)
    ]
cfgValToJson (CommandV Command
cmd) = JSString -> JSValue
JSString (JSString -> JSValue) -> JSString -> JSValue
forall a b. (a -> b) -> a -> b
$ FilePath -> JSString
toJSString (FilePath -> JSString) -> FilePath -> JSString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
formatCommand Command
cmd
cfgValToJson (ListOfV [ConfigValue a]
xs) = [JSValue] -> JSValue
JSArray ([JSValue] -> JSValue) -> [JSValue] -> JSValue
forall a b. (a -> b) -> a -> b
$ (ConfigValue a -> JSValue) -> [ConfigValue a] -> [JSValue]
forall a b. (a -> b) -> [a] -> [b]
map ConfigValue a -> JSValue
forall (t :: ConfigValueType). ConfigValue t -> JSValue
cfgValToJson [ConfigValue a]
xs
cfgValToJson (MaybeV Maybe (ConfigValue a)
Nothing) = JSValue
JSNull
cfgValToJson (MaybeV (Just ConfigValue a
x)) = ConfigValue a -> JSValue
forall (t :: ConfigValueType). ConfigValue t -> JSValue
cfgValToJson ConfigValue a
x

-- | Convert a configuration value to a JSON value. Used in `hoyo config print --json`.
anyCfgValToJson :: AnyConfigValue -> JSValue
anyCfgValToJson :: AnyConfigValue -> JSValue
anyCfgValToJson (AnyConfigValue ConfigValue t
val) = ConfigValue t -> JSValue
forall (t :: ConfigValueType). ConfigValue t -> JSValue
cfgValToJson ConfigValue t
val

withTitle :: T.Text -> [T.Text] -> T.Text
withTitle :: Text -> [Text] -> Text
withTitle Text
title []    = Text
title
withTitle Text
title [Text
one] = Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
one
withTitle Text
title [Text]
ts    = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ts

formatFsException :: FileSystemException -> T.Text
formatFsException :: FileSystemException -> Text
formatFsException (NoFileException FilePath
fp) = Text -> [Text] -> Text
withTitle Text
"file not found" [FilePath -> Text
T.pack FilePath
fp]
formatFsException (NoDirException FilePath
fp) = Text -> [Text] -> Text
withTitle Text
"directory not found" [FilePath -> Text
T.pack FilePath
fp]

formatCmdException :: CommandException -> T.Text
formatCmdException :: CommandException -> Text
formatCmdException (SearchException (NothingFound BookmarkSearchTerm
search)) = Text -> [Text] -> Text
withTitle Text
"unknown bookmark" [BookmarkSearchTerm -> Text
formatSearchTermPretty BookmarkSearchTerm
search]
formatCmdException (SearchException (TooManyResults BookmarkSearchTerm
search [Text]
bms)) = Text -> [Text] -> Text
withTitle (Text
"multiple bookmarks matching search [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BookmarkSearchTerm -> Text
forall a. Show a => a -> Text
tshow BookmarkSearchTerm
search Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") [Text]
bms
formatCmdException (InvalidArgumentException [Text]
ts) = Text -> [Text] -> Text
withTitle Text
"invalid argument(s)" [Text]
ts
formatCmdException CommandException
LoopException = Text -> [Text] -> Text
withTitle Text
"default command" [Text
"stuck in a loop"]

-- | Format a 'HoyoException' to display to the user.
formatException :: HoyoException -> T.Text
formatException :: HoyoException -> Text
formatException (ConfigException [Text]
ts) = Text -> [Text] -> Text
withTitle Text
"config error" [Text]
ts
formatException (CommandException CommandException
cmdExc) = CommandException -> Text
formatCmdException CommandException
cmdExc
formatException (IOException IOError
ioExc) = Text -> [Text] -> Text
withTitle Text
"IO error:" [IOError -> Text
forall a. Show a => a -> Text
tshow IOError
ioExc]
formatException (FileSystemException FileSystemException
exc) = FileSystemException -> Text
formatFsException FileSystemException
exc
formatException (ParseException [Text]
ts) = Text -> [Text] -> Text
withTitle Text
"parse error" [Text]
ts
formatException (MultipleExceptions NonEmpty HoyoException
excs) = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (HoyoException -> Text) -> [HoyoException] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map HoyoException -> Text
formatException ([HoyoException] -> [Text]) -> [HoyoException] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty HoyoException -> [HoyoException]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty HoyoException
excs

-- | Catch an 'GHC.IO.Exception.IOException' and wrap it in a 'HoyoException'.
catchIOException :: Monad m => IOException -> m (Either HoyoException a)
catchIOException :: IOError -> m (Either HoyoException a)
catchIOException IOError
exc = Either HoyoException a -> m (Either HoyoException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HoyoException a -> m (Either HoyoException a))
-> Either HoyoException a -> m (Either HoyoException a)
forall a b. (a -> b) -> a -> b
$ HoyoException -> Either HoyoException a
forall a b. a -> Either a b
Left (HoyoException -> Either HoyoException a)
-> HoyoException -> Either HoyoException a
forall a b. (a -> b) -> a -> b
$ IOError -> HoyoException
IOException IOError
exc