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

Types used by all the main Hoyo.* modules.
-}

{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE GADTs           #-}
{-# LANGUAGE KindSignatures  #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wno-missing-signatures #-}
{-# OPTIONS_HADDOCK prune #-}

module Hoyo.Internal.Types where

import           Control.Monad.Catch
import           Control.Monad.Except       (ExceptT, MonadError (..))
import           Control.Monad.IO.Class
import           Control.Monad.Reader.Class (MonadReader)
import           Control.Monad.Trans.Reader (ReaderT)

import           Data.Function
import           Data.List                  (intercalate)
import qualified Data.List.NonEmpty         as NE
import qualified Data.Text                  as T
import           Data.Time

import           GHC.Generics

import           Language.Haskell.TH.Syntax

import           Lens.Micro
import           Lens.Micro.TH

import           System.IO.Error

-- | The main hoyo read-only environment. Contains the current saved bookmarks,
-- the current hoyo configuration, and the file locations for each.
data Env
  = Env { Env -> Bookmarks
_bookmarks     :: !Bookmarks
        , Env -> FilePath
_bookmarksPath :: !FilePath
        , Env -> Config
_config        :: !Config
        , Env -> FilePath
_configPath    :: !FilePath
        }
  deriving (Int -> Env -> ShowS
[Env] -> ShowS
Env -> FilePath
(Int -> Env -> ShowS)
-> (Env -> FilePath) -> ([Env] -> ShowS) -> Show Env
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Env] -> ShowS
$cshowList :: [Env] -> ShowS
show :: Env -> FilePath
$cshow :: Env -> FilePath
showsPrec :: Int -> Env -> ShowS
$cshowsPrec :: Int -> Env -> ShowS
Show)

-- | Bookmark a directory for easy @cd@. A bookmark remembers the directory,
-- the index, the creation time, and optionally a user-specified nickname
-- for the bookmark.
data Bookmark
  = Bookmark { Bookmark -> FilePath
_bookmarkDirectory    :: !FilePath
             , Bookmark -> Int
_bookmarkIndex        :: !Int
             , Bookmark -> ZonedTime
_bookmarkCreationTime :: !ZonedTime
             , Bookmark -> Maybe Text
_bookmarkName         :: !(Maybe T.Text)
             }
  deriving (Int -> Bookmark -> ShowS
[Bookmark] -> ShowS
Bookmark -> FilePath
(Int -> Bookmark -> ShowS)
-> (Bookmark -> FilePath) -> ([Bookmark] -> ShowS) -> Show Bookmark
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Bookmark] -> ShowS
$cshowList :: [Bookmark] -> ShowS
show :: Bookmark -> FilePath
$cshow :: Bookmark -> FilePath
showsPrec :: Int -> Bookmark -> ShowS
$cshowsPrec :: Int -> Bookmark -> ShowS
Show)

instance Eq Bookmark where
  Bookmark FilePath
d1 Int
i1 ZonedTime
_ Maybe Text
n1 == :: Bookmark -> Bookmark -> Bool
== Bookmark FilePath
d2 Int
i2 ZonedTime
_ Maybe Text
n2
    = FilePath
d1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
d2
   Bool -> Bool -> Bool
&& Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2
   Bool -> Bool -> Bool
&& Maybe Text
n1 Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
n2

-- | Default bookmarks to save at init. A default bookmark remembers the directory
-- and optionally a user-specified nickname for the bookmark.
data DefaultBookmark
  = DefaultBookmark { DefaultBookmark -> FilePath
_defaultBookmarkDirectory :: !FilePath
                    , DefaultBookmark -> Maybe Text
_defaultBookmarkName      :: !(Maybe T.Text)
                    }
  deriving (Int -> DefaultBookmark -> ShowS
[DefaultBookmark] -> ShowS
DefaultBookmark -> FilePath
(Int -> DefaultBookmark -> ShowS)
-> (DefaultBookmark -> FilePath)
-> ([DefaultBookmark] -> ShowS)
-> Show DefaultBookmark
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DefaultBookmark] -> ShowS
$cshowList :: [DefaultBookmark] -> ShowS
show :: DefaultBookmark -> FilePath
$cshow :: DefaultBookmark -> FilePath
showsPrec :: Int -> DefaultBookmark -> ShowS
$cshowsPrec :: Int -> DefaultBookmark -> ShowS
Show, DefaultBookmark -> DefaultBookmark -> Bool
(DefaultBookmark -> DefaultBookmark -> Bool)
-> (DefaultBookmark -> DefaultBookmark -> Bool)
-> Eq DefaultBookmark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultBookmark -> DefaultBookmark -> Bool
$c/= :: DefaultBookmark -> DefaultBookmark -> Bool
== :: DefaultBookmark -> DefaultBookmark -> Bool
$c== :: DefaultBookmark -> DefaultBookmark -> Bool
Eq)

-- | Wrapper for @['Bookmark']@.
newtype Bookmarks
  = Bookmarks { Bookmarks -> [Bookmark]
unBookmarks :: [Bookmark] }
  deriving (Int -> Bookmarks -> ShowS
[Bookmarks] -> ShowS
Bookmarks -> FilePath
(Int -> Bookmarks -> ShowS)
-> (Bookmarks -> FilePath)
-> ([Bookmarks] -> ShowS)
-> Show Bookmarks
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Bookmarks] -> ShowS
$cshowList :: [Bookmarks] -> ShowS
show :: Bookmarks -> FilePath
$cshow :: Bookmarks -> FilePath
showsPrec :: Int -> Bookmarks -> ShowS
$cshowsPrec :: Int -> Bookmarks -> ShowS
Show)

-- | Data-type for represting a bookmark search. You can either search
-- by index or by name. Used by the @delete@ and @move@ commands.
data BookmarkSearchTerm
  = SearchIndex Int
  | SearchName T.Text
  deriving (Int -> BookmarkSearchTerm -> ShowS
[BookmarkSearchTerm] -> ShowS
BookmarkSearchTerm -> FilePath
(Int -> BookmarkSearchTerm -> ShowS)
-> (BookmarkSearchTerm -> FilePath)
-> ([BookmarkSearchTerm] -> ShowS)
-> Show BookmarkSearchTerm
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BookmarkSearchTerm] -> ShowS
$cshowList :: [BookmarkSearchTerm] -> ShowS
show :: BookmarkSearchTerm -> FilePath
$cshow :: BookmarkSearchTerm -> FilePath
showsPrec :: Int -> BookmarkSearchTerm -> ShowS
$cshowsPrec :: Int -> BookmarkSearchTerm -> ShowS
Show, BookmarkSearchTerm -> BookmarkSearchTerm -> Bool
(BookmarkSearchTerm -> BookmarkSearchTerm -> Bool)
-> (BookmarkSearchTerm -> BookmarkSearchTerm -> Bool)
-> Eq BookmarkSearchTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BookmarkSearchTerm -> BookmarkSearchTerm -> Bool
$c/= :: BookmarkSearchTerm -> BookmarkSearchTerm -> Bool
== :: BookmarkSearchTerm -> BookmarkSearchTerm -> Bool
$c== :: BookmarkSearchTerm -> BookmarkSearchTerm -> Bool
Eq)

-- | The types of config values allowed in the Hoyo config.
data ConfigValueType
  = TBool
  | TDefaultBookmark
  | TCommand
  | TList ConfigValueType
  | TMaybe ConfigValueType

-- | Values in the Hoyo config. Using a GADT parameterised by 'ConfigValueType'
-- gives us stricter type safety.
data ConfigValue (t :: ConfigValueType) where
  BoolV :: Bool -> ConfigValue 'TBool
  DefaultBookmarkV :: DefaultBookmark -> ConfigValue 'TDefaultBookmark
  CommandV :: Command -> ConfigValue 'TCommand
  ListOfV :: forall (a :: ConfigValueType). [ConfigValue a] -> ConfigValue ('TList a)
  MaybeV :: forall (a :: ConfigValueType). Maybe (ConfigValue a) -> ConfigValue ('TMaybe a)

instance Show (ConfigValue (t :: ConfigValueType)) where
  show :: ConfigValue t -> FilePath
show (BoolV Bool
bool)          = Bool -> FilePath
forall a. Show a => a -> FilePath
show Bool
bool
  show (DefaultBookmarkV DefaultBookmark
bm) = DefaultBookmark -> FilePath
forall a. Show a => a -> FilePath
show DefaultBookmark
bm
  show (CommandV Command
t)          = Command -> FilePath
forall a. Show a => a -> FilePath
show Command
t
  show (ListOfV [ConfigValue a]
xs)          = FilePath
"[" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((ConfigValue a -> FilePath) -> [ConfigValue a] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ConfigValue a -> FilePath
forall a. Show a => a -> FilePath
show [ConfigValue a]
xs) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"]"
  show (MaybeV Maybe (ConfigValue a)
xs)           = Maybe (ConfigValue a) -> FilePath
forall a. Show a => a -> FilePath
show Maybe (ConfigValue a)
xs

instance Eq (ConfigValue (t :: ConfigValueType)) where
  BoolV Bool
b1            == :: ConfigValue t -> ConfigValue t -> Bool
== BoolV Bool
b2            = Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2
  DefaultBookmarkV DefaultBookmark
b1 == DefaultBookmarkV DefaultBookmark
b2 = DefaultBookmark
b1 DefaultBookmark -> DefaultBookmark -> Bool
forall a. Eq a => a -> a -> Bool
== DefaultBookmark
b2
  CommandV Command
b1         == CommandV Command
b2         = Command
b1 Command -> Command -> Bool
forall a. Eq a => a -> a -> Bool
== Command
b2
  ListOfV [ConfigValue a]
b1          == ListOfV [ConfigValue a]
b2          = [ConfigValue a]
b1 [ConfigValue a] -> [ConfigValue a] -> Bool
forall a. Eq a => a -> a -> Bool
== [ConfigValue a]
[ConfigValue a]
b2
  MaybeV Maybe (ConfigValue a)
b1           == MaybeV Maybe (ConfigValue a)
b2           = Maybe (ConfigValue a)
b1 Maybe (ConfigValue a) -> Maybe (ConfigValue a) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (ConfigValue a)
Maybe (ConfigValue a)
b2

-- | Existential wrapper around 'ConfigValue'.
data AnyConfigValue
  = forall (t :: ConfigValueType). AnyConfigValue (ConfigValue t)

-- | A representation of hoyo settings.
data Config
  = Config { Config -> ConfigValue 'TBool
_failOnError         :: !(ConfigValue 'TBool)
           , Config -> ConfigValue 'TBool
_displayCreationTime :: !(ConfigValue 'TBool)
           , Config -> ConfigValue 'TBool
_enableClearing      :: !(ConfigValue 'TBool)
           , Config -> ConfigValue 'TBool
_enableReset         :: !(ConfigValue 'TBool)
           , Config -> ConfigValue 'TBool
_backupBeforeClear   :: !(ConfigValue 'TBool)
           , Config -> ConfigValue ('TList 'TDefaultBookmark)
_defaultBookmarks    :: !(ConfigValue ('TList 'TDefaultBookmark))
           , Config -> ConfigValue ('TMaybe 'TCommand)
_defaultCommand      :: !(ConfigValue ('TMaybe 'TCommand))
           }
  deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
(Int -> Config -> ShowS)
-> (Config -> FilePath) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> FilePath
$cshow :: Config -> FilePath
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq)

-- | Report an exception while searching for a bookmark.
data SearchException
  = NothingFound BookmarkSearchTerm
  | TooManyResults BookmarkSearchTerm [T.Text]
  deriving (Int -> SearchException -> ShowS
[SearchException] -> ShowS
SearchException -> FilePath
(Int -> SearchException -> ShowS)
-> (SearchException -> FilePath)
-> ([SearchException] -> ShowS)
-> Show SearchException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SearchException] -> ShowS
$cshowList :: [SearchException] -> ShowS
show :: SearchException -> FilePath
$cshow :: SearchException -> FilePath
showsPrec :: Int -> SearchException -> ShowS
$cshowsPrec :: Int -> SearchException -> ShowS
Show, SearchException -> SearchException -> Bool
(SearchException -> SearchException -> Bool)
-> (SearchException -> SearchException -> Bool)
-> Eq SearchException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchException -> SearchException -> Bool
$c/= :: SearchException -> SearchException -> Bool
== :: SearchException -> SearchException -> Bool
$c== :: SearchException -> SearchException -> Bool
Eq, (forall x. SearchException -> Rep SearchException x)
-> (forall x. Rep SearchException x -> SearchException)
-> Generic SearchException
forall x. Rep SearchException x -> SearchException
forall x. SearchException -> Rep SearchException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchException x -> SearchException
$cfrom :: forall x. SearchException -> Rep SearchException x
Generic)

-- | Report an exception while running a command.
data CommandException
  = SearchException SearchException
  | InvalidArgumentException [T.Text]
  | LoopException
  deriving (Int -> CommandException -> ShowS
[CommandException] -> ShowS
CommandException -> FilePath
(Int -> CommandException -> ShowS)
-> (CommandException -> FilePath)
-> ([CommandException] -> ShowS)
-> Show CommandException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CommandException] -> ShowS
$cshowList :: [CommandException] -> ShowS
show :: CommandException -> FilePath
$cshow :: CommandException -> FilePath
showsPrec :: Int -> CommandException -> ShowS
$cshowsPrec :: Int -> CommandException -> ShowS
Show, CommandException -> CommandException -> Bool
(CommandException -> CommandException -> Bool)
-> (CommandException -> CommandException -> Bool)
-> Eq CommandException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandException -> CommandException -> Bool
$c/= :: CommandException -> CommandException -> Bool
== :: CommandException -> CommandException -> Bool
$c== :: CommandException -> CommandException -> Bool
Eq, (forall x. CommandException -> Rep CommandException x)
-> (forall x. Rep CommandException x -> CommandException)
-> Generic CommandException
forall x. Rep CommandException x -> CommandException
forall x. CommandException -> Rep CommandException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommandException x -> CommandException
$cfrom :: forall x. CommandException -> Rep CommandException x
Generic)

-- | Report a file system exception.
data FileSystemException
  = NoFileException FilePath
  | NoDirException FilePath
  deriving (Int -> FileSystemException -> ShowS
[FileSystemException] -> ShowS
FileSystemException -> FilePath
(Int -> FileSystemException -> ShowS)
-> (FileSystemException -> FilePath)
-> ([FileSystemException] -> ShowS)
-> Show FileSystemException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileSystemException] -> ShowS
$cshowList :: [FileSystemException] -> ShowS
show :: FileSystemException -> FilePath
$cshow :: FileSystemException -> FilePath
showsPrec :: Int -> FileSystemException -> ShowS
$cshowsPrec :: Int -> FileSystemException -> ShowS
Show, FileSystemException -> FileSystemException -> Bool
(FileSystemException -> FileSystemException -> Bool)
-> (FileSystemException -> FileSystemException -> Bool)
-> Eq FileSystemException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSystemException -> FileSystemException -> Bool
$c/= :: FileSystemException -> FileSystemException -> Bool
== :: FileSystemException -> FileSystemException -> Bool
$c== :: FileSystemException -> FileSystemException -> Bool
Eq, (forall x. FileSystemException -> Rep FileSystemException x)
-> (forall x. Rep FileSystemException x -> FileSystemException)
-> Generic FileSystemException
forall x. Rep FileSystemException x -> FileSystemException
forall x. FileSystemException -> Rep FileSystemException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileSystemException x -> FileSystemException
$cfrom :: forall x. FileSystemException -> Rep FileSystemException x
Generic)

-- | A custom hierarchical exception type for hoyo.
data HoyoException
  = ConfigException [T.Text]
  | CommandException CommandException
  | IOException IOError
  | FileSystemException FileSystemException
  | ParseException [T.Text]
  | MultipleExceptions (NE.NonEmpty HoyoException)
  deriving (Int -> HoyoException -> ShowS
[HoyoException] -> ShowS
HoyoException -> FilePath
(Int -> HoyoException -> ShowS)
-> (HoyoException -> FilePath)
-> ([HoyoException] -> ShowS)
-> Show HoyoException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HoyoException] -> ShowS
$cshowList :: [HoyoException] -> ShowS
show :: HoyoException -> FilePath
$cshow :: HoyoException -> FilePath
showsPrec :: Int -> HoyoException -> ShowS
$cshowsPrec :: Int -> HoyoException -> ShowS
Show, HoyoException -> HoyoException -> Bool
(HoyoException -> HoyoException -> Bool)
-> (HoyoException -> HoyoException -> Bool) -> Eq HoyoException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoyoException -> HoyoException -> Bool
$c/= :: HoyoException -> HoyoException -> Bool
== :: HoyoException -> HoyoException -> Bool
$c== :: HoyoException -> HoyoException -> Bool
Eq, (forall x. HoyoException -> Rep HoyoException x)
-> (forall x. Rep HoyoException x -> HoyoException)
-> Generic HoyoException
forall x. Rep HoyoException x -> HoyoException
forall x. HoyoException -> Rep HoyoException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoyoException x -> HoyoException
$cfrom :: forall x. HoyoException -> Rep HoyoException x
Generic)

instance Semigroup HoyoException where
  MultipleExceptions NonEmpty HoyoException
ne1 <> :: HoyoException -> HoyoException -> HoyoException
<> MultipleExceptions NonEmpty HoyoException
ne2 = NonEmpty HoyoException -> HoyoException
MultipleExceptions (NonEmpty HoyoException
ne1 NonEmpty HoyoException
-> NonEmpty HoyoException -> NonEmpty HoyoException
forall a. Semigroup a => a -> a -> a
<> NonEmpty HoyoException
ne2)
  MultipleExceptions NonEmpty HoyoException
ne <> HoyoException
x = NonEmpty HoyoException -> HoyoException
MultipleExceptions (NonEmpty HoyoException
ne NonEmpty HoyoException
-> NonEmpty HoyoException -> NonEmpty HoyoException
forall a. Semigroup a => a -> a -> a
<> (HoyoException
x HoyoException -> [HoyoException] -> NonEmpty HoyoException
forall a. a -> [a] -> NonEmpty a
NE.:| []))
  HoyoException
x <> MultipleExceptions NonEmpty HoyoException
ne = NonEmpty HoyoException -> HoyoException
MultipleExceptions (HoyoException
x HoyoException -> NonEmpty HoyoException -> NonEmpty HoyoException
forall a. a -> NonEmpty a -> NonEmpty a
NE.<| NonEmpty HoyoException
ne)
  ConfigException [Text]
xs <> ConfigException [Text]
ys = [Text] -> HoyoException
ConfigException ([Text] -> HoyoException) -> [Text] -> HoyoException
forall a b. (a -> b) -> a -> b
$ [Text]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ys
  ParseException [Text]
xs <> ParseException [Text]
ys = [Text] -> HoyoException
ParseException ([Text] -> HoyoException) -> [Text] -> HoyoException
forall a b. (a -> b) -> a -> b
$ [Text]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ys
  CommandException (InvalidArgumentException [Text]
xs) <> CommandException (InvalidArgumentException [Text]
ys)
    = CommandException -> HoyoException
CommandException ([Text] -> CommandException
InvalidArgumentException ([Text]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ys))
  HoyoException
x <> HoyoException
y = NonEmpty HoyoException -> HoyoException
MultipleExceptions (HoyoException
x HoyoException -> [HoyoException] -> NonEmpty HoyoException
forall a. a -> [a] -> NonEmpty a
NE.:| [HoyoException
y])

-- | 'HoyoMonad' is the main monad stack for the hoyo program. It's essentially a wrapper
-- around @ExceptT T.Text (ReaderT Env IO)@: in other words,
-- @HoyoMonad a@ is equivalent to @Env -> IO (Either T.Text a)@
newtype HoyoMonad a
  = HoyoMonad { HoyoMonad a -> ExceptT HoyoException (ReaderT Env IO) a
unHoyo :: ExceptT HoyoException (ReaderT Env IO) a }
  deriving
  ( a -> HoyoMonad b -> HoyoMonad a
(a -> b) -> HoyoMonad a -> HoyoMonad b
(forall a b. (a -> b) -> HoyoMonad a -> HoyoMonad b)
-> (forall a b. a -> HoyoMonad b -> HoyoMonad a)
-> Functor HoyoMonad
forall a b. a -> HoyoMonad b -> HoyoMonad a
forall a b. (a -> b) -> HoyoMonad a -> HoyoMonad b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HoyoMonad b -> HoyoMonad a
$c<$ :: forall a b. a -> HoyoMonad b -> HoyoMonad a
fmap :: (a -> b) -> HoyoMonad a -> HoyoMonad b
$cfmap :: forall a b. (a -> b) -> HoyoMonad a -> HoyoMonad b
Functor
  , Functor HoyoMonad
a -> HoyoMonad a
Functor HoyoMonad
-> (forall a. a -> HoyoMonad a)
-> (forall a b. HoyoMonad (a -> b) -> HoyoMonad a -> HoyoMonad b)
-> (forall a b c.
    (a -> b -> c) -> HoyoMonad a -> HoyoMonad b -> HoyoMonad c)
-> (forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad b)
-> (forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad a)
-> Applicative HoyoMonad
HoyoMonad a -> HoyoMonad b -> HoyoMonad b
HoyoMonad a -> HoyoMonad b -> HoyoMonad a
HoyoMonad (a -> b) -> HoyoMonad a -> HoyoMonad b
(a -> b -> c) -> HoyoMonad a -> HoyoMonad b -> HoyoMonad c
forall a. a -> HoyoMonad a
forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad a
forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad b
forall a b. HoyoMonad (a -> b) -> HoyoMonad a -> HoyoMonad b
forall a b c.
(a -> b -> c) -> HoyoMonad a -> HoyoMonad b -> HoyoMonad c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: HoyoMonad a -> HoyoMonad b -> HoyoMonad a
$c<* :: forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad a
*> :: HoyoMonad a -> HoyoMonad b -> HoyoMonad b
$c*> :: forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad b
liftA2 :: (a -> b -> c) -> HoyoMonad a -> HoyoMonad b -> HoyoMonad c
$cliftA2 :: forall a b c.
(a -> b -> c) -> HoyoMonad a -> HoyoMonad b -> HoyoMonad c
<*> :: HoyoMonad (a -> b) -> HoyoMonad a -> HoyoMonad b
$c<*> :: forall a b. HoyoMonad (a -> b) -> HoyoMonad a -> HoyoMonad b
pure :: a -> HoyoMonad a
$cpure :: forall a. a -> HoyoMonad a
$cp1Applicative :: Functor HoyoMonad
Applicative
  , Applicative HoyoMonad
a -> HoyoMonad a
Applicative HoyoMonad
-> (forall a b. HoyoMonad a -> (a -> HoyoMonad b) -> HoyoMonad b)
-> (forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad b)
-> (forall a. a -> HoyoMonad a)
-> Monad HoyoMonad
HoyoMonad a -> (a -> HoyoMonad b) -> HoyoMonad b
HoyoMonad a -> HoyoMonad b -> HoyoMonad b
forall a. a -> HoyoMonad a
forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad b
forall a b. HoyoMonad a -> (a -> HoyoMonad b) -> HoyoMonad b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> HoyoMonad a
$creturn :: forall a. a -> HoyoMonad a
>> :: HoyoMonad a -> HoyoMonad b -> HoyoMonad b
$c>> :: forall a b. HoyoMonad a -> HoyoMonad b -> HoyoMonad b
>>= :: HoyoMonad a -> (a -> HoyoMonad b) -> HoyoMonad b
$c>>= :: forall a b. HoyoMonad a -> (a -> HoyoMonad b) -> HoyoMonad b
$cp1Monad :: Applicative HoyoMonad
Monad
  , MonadError HoyoException
  , MonadReader Env
  , Monad HoyoMonad
e -> HoyoMonad a
Monad HoyoMonad
-> (forall e a. Exception e => e -> HoyoMonad a)
-> MonadThrow HoyoMonad
forall e a. Exception e => e -> HoyoMonad a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> HoyoMonad a
$cthrowM :: forall e a. Exception e => e -> HoyoMonad a
$cp1MonadThrow :: Monad HoyoMonad
MonadThrow
  , MonadThrow HoyoMonad
MonadThrow HoyoMonad
-> (forall e a.
    Exception e =>
    HoyoMonad a -> (e -> HoyoMonad a) -> HoyoMonad a)
-> MonadCatch HoyoMonad
HoyoMonad a -> (e -> HoyoMonad a) -> HoyoMonad a
forall e a.
Exception e =>
HoyoMonad a -> (e -> HoyoMonad a) -> HoyoMonad a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: HoyoMonad a -> (e -> HoyoMonad a) -> HoyoMonad a
$ccatch :: forall e a.
Exception e =>
HoyoMonad a -> (e -> HoyoMonad a) -> HoyoMonad a
$cp1MonadCatch :: MonadThrow HoyoMonad
MonadCatch
  )

instance MonadIO HoyoMonad where
  liftIO :: IO a -> HoyoMonad a
liftIO IO a
m = ExceptT HoyoException (ReaderT Env IO) (Either IOError a)
-> HoyoMonad (Either IOError a)
forall a. ExceptT HoyoException (ReaderT Env IO) a -> HoyoMonad a
HoyoMonad (IO (Either IOError a)
-> ExceptT HoyoException (ReaderT Env IO) (Either IOError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError a)
 -> ExceptT HoyoException (ReaderT Env IO) (Either IOError a))
-> IO (Either IOError a)
-> ExceptT HoyoException (ReaderT Env IO) (Either IOError a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError IO a
m) HoyoMonad (Either IOError a)
-> (Either IOError a -> HoyoMonad a) -> HoyoMonad a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left IOError
err     -> HoyoException -> HoyoMonad a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HoyoException -> HoyoMonad a) -> HoyoException -> HoyoMonad a
forall a b. (a -> b) -> a -> b
$ IOError -> HoyoException
IOException IOError
err
    Right a
result -> a -> HoyoMonad a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Options for the "add" command to be parsed from the command-line.
data AddOptions
  = AddOptions { AddOptions -> FilePath
addDirectory :: FilePath
               , AddOptions -> Maybe Text
addName      :: Maybe T.Text
               }
  deriving (Int -> AddOptions -> ShowS
[AddOptions] -> ShowS
AddOptions -> FilePath
(Int -> AddOptions -> ShowS)
-> (AddOptions -> FilePath)
-> ([AddOptions] -> ShowS)
-> Show AddOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AddOptions] -> ShowS
$cshowList :: [AddOptions] -> ShowS
show :: AddOptions -> FilePath
$cshow :: AddOptions -> FilePath
showsPrec :: Int -> AddOptions -> ShowS
$cshowsPrec :: Int -> AddOptions -> ShowS
Show, AddOptions -> AddOptions -> Bool
(AddOptions -> AddOptions -> Bool)
-> (AddOptions -> AddOptions -> Bool) -> Eq AddOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddOptions -> AddOptions -> Bool
$c/= :: AddOptions -> AddOptions -> Bool
== :: AddOptions -> AddOptions -> Bool
$c== :: AddOptions -> AddOptions -> Bool
Eq)

-- | Options for the "move" command to be parsed from the command-line.
newtype MoveOptions
  = MoveOptions { MoveOptions -> BookmarkSearchTerm
moveSearch :: BookmarkSearchTerm }
  deriving (Int -> MoveOptions -> ShowS
[MoveOptions] -> ShowS
MoveOptions -> FilePath
(Int -> MoveOptions -> ShowS)
-> (MoveOptions -> FilePath)
-> ([MoveOptions] -> ShowS)
-> Show MoveOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MoveOptions] -> ShowS
$cshowList :: [MoveOptions] -> ShowS
show :: MoveOptions -> FilePath
$cshow :: MoveOptions -> FilePath
showsPrec :: Int -> MoveOptions -> ShowS
$cshowsPrec :: Int -> MoveOptions -> ShowS
Show, MoveOptions -> MoveOptions -> Bool
(MoveOptions -> MoveOptions -> Bool)
-> (MoveOptions -> MoveOptions -> Bool) -> Eq MoveOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoveOptions -> MoveOptions -> Bool
$c/= :: MoveOptions -> MoveOptions -> Bool
== :: MoveOptions -> MoveOptions -> Bool
$c== :: MoveOptions -> MoveOptions -> Bool
Eq)

-- | Options for the "list" command to be parsed from the command-line.
data ListOptions
  = ListOptions { ListOptions -> Maybe Text
listFilterName           :: Maybe T.Text
                , ListOptions -> Maybe Text
listFilterDirectoryInfix :: Maybe T.Text
                , ListOptions -> Bool
listJSONOutput           :: Bool
                }
  deriving (Int -> ListOptions -> ShowS
[ListOptions] -> ShowS
ListOptions -> FilePath
(Int -> ListOptions -> ShowS)
-> (ListOptions -> FilePath)
-> ([ListOptions] -> ShowS)
-> Show ListOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ListOptions] -> ShowS
$cshowList :: [ListOptions] -> ShowS
show :: ListOptions -> FilePath
$cshow :: ListOptions -> FilePath
showsPrec :: Int -> ListOptions -> ShowS
$cshowsPrec :: Int -> ListOptions -> ShowS
Show, ListOptions -> ListOptions -> Bool
(ListOptions -> ListOptions -> Bool)
-> (ListOptions -> ListOptions -> Bool) -> Eq ListOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListOptions -> ListOptions -> Bool
$c/= :: ListOptions -> ListOptions -> Bool
== :: ListOptions -> ListOptions -> Bool
$c== :: ListOptions -> ListOptions -> Bool
Eq)

-- | Options for the "clear" command to be parsed from the command-line.
data ClearOptions = ClearOptions deriving (Int -> ClearOptions -> ShowS
[ClearOptions] -> ShowS
ClearOptions -> FilePath
(Int -> ClearOptions -> ShowS)
-> (ClearOptions -> FilePath)
-> ([ClearOptions] -> ShowS)
-> Show ClearOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ClearOptions] -> ShowS
$cshowList :: [ClearOptions] -> ShowS
show :: ClearOptions -> FilePath
$cshow :: ClearOptions -> FilePath
showsPrec :: Int -> ClearOptions -> ShowS
$cshowsPrec :: Int -> ClearOptions -> ShowS
Show, ClearOptions -> ClearOptions -> Bool
(ClearOptions -> ClearOptions -> Bool)
-> (ClearOptions -> ClearOptions -> Bool) -> Eq ClearOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClearOptions -> ClearOptions -> Bool
$c/= :: ClearOptions -> ClearOptions -> Bool
== :: ClearOptions -> ClearOptions -> Bool
$c== :: ClearOptions -> ClearOptions -> Bool
Eq)

-- | Options for the "delete" command to be parsed from the command-line.
newtype DeleteOptions
  = DeleteOptions { DeleteOptions -> BookmarkSearchTerm
deleteSearch :: BookmarkSearchTerm }
  deriving (Int -> DeleteOptions -> ShowS
[DeleteOptions] -> ShowS
DeleteOptions -> FilePath
(Int -> DeleteOptions -> ShowS)
-> (DeleteOptions -> FilePath)
-> ([DeleteOptions] -> ShowS)
-> Show DeleteOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DeleteOptions] -> ShowS
$cshowList :: [DeleteOptions] -> ShowS
show :: DeleteOptions -> FilePath
$cshow :: DeleteOptions -> FilePath
showsPrec :: Int -> DeleteOptions -> ShowS
$cshowsPrec :: Int -> DeleteOptions -> ShowS
Show, DeleteOptions -> DeleteOptions -> Bool
(DeleteOptions -> DeleteOptions -> Bool)
-> (DeleteOptions -> DeleteOptions -> Bool) -> Eq DeleteOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteOptions -> DeleteOptions -> Bool
$c/= :: DeleteOptions -> DeleteOptions -> Bool
== :: DeleteOptions -> DeleteOptions -> Bool
$c== :: DeleteOptions -> DeleteOptions -> Bool
Eq)

-- | Options for the "refresh" command to be parsed from the command-line.
data RefreshOptions = RefreshOptions deriving (Int -> RefreshOptions -> ShowS
[RefreshOptions] -> ShowS
RefreshOptions -> FilePath
(Int -> RefreshOptions -> ShowS)
-> (RefreshOptions -> FilePath)
-> ([RefreshOptions] -> ShowS)
-> Show RefreshOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RefreshOptions] -> ShowS
$cshowList :: [RefreshOptions] -> ShowS
show :: RefreshOptions -> FilePath
$cshow :: RefreshOptions -> FilePath
showsPrec :: Int -> RefreshOptions -> ShowS
$cshowsPrec :: Int -> RefreshOptions -> ShowS
Show, RefreshOptions -> RefreshOptions -> Bool
(RefreshOptions -> RefreshOptions -> Bool)
-> (RefreshOptions -> RefreshOptions -> Bool) -> Eq RefreshOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshOptions -> RefreshOptions -> Bool
$c/= :: RefreshOptions -> RefreshOptions -> Bool
== :: RefreshOptions -> RefreshOptions -> Bool
$c== :: RefreshOptions -> RefreshOptions -> Bool
Eq)

-- | Options for the "config print" command to be parsed from the command-line.
newtype ConfigPrintOptions
  = ConfigPrintOptions { ConfigPrintOptions -> Bool
configPrintJSONOuput :: Bool }
  deriving (Int -> ConfigPrintOptions -> ShowS
[ConfigPrintOptions] -> ShowS
ConfigPrintOptions -> FilePath
(Int -> ConfigPrintOptions -> ShowS)
-> (ConfigPrintOptions -> FilePath)
-> ([ConfigPrintOptions] -> ShowS)
-> Show ConfigPrintOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigPrintOptions] -> ShowS
$cshowList :: [ConfigPrintOptions] -> ShowS
show :: ConfigPrintOptions -> FilePath
$cshow :: ConfigPrintOptions -> FilePath
showsPrec :: Int -> ConfigPrintOptions -> ShowS
$cshowsPrec :: Int -> ConfigPrintOptions -> ShowS
Show, ConfigPrintOptions -> ConfigPrintOptions -> Bool
(ConfigPrintOptions -> ConfigPrintOptions -> Bool)
-> (ConfigPrintOptions -> ConfigPrintOptions -> Bool)
-> Eq ConfigPrintOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigPrintOptions -> ConfigPrintOptions -> Bool
$c/= :: ConfigPrintOptions -> ConfigPrintOptions -> Bool
== :: ConfigPrintOptions -> ConfigPrintOptions -> Bool
$c== :: ConfigPrintOptions -> ConfigPrintOptions -> Bool
Eq)

-- | Options for the "config reset" command to be parsed from the command-line.
data ConfigResetOptions = ConfigResetOptions deriving (Int -> ConfigResetOptions -> ShowS
[ConfigResetOptions] -> ShowS
ConfigResetOptions -> FilePath
(Int -> ConfigResetOptions -> ShowS)
-> (ConfigResetOptions -> FilePath)
-> ([ConfigResetOptions] -> ShowS)
-> Show ConfigResetOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigResetOptions] -> ShowS
$cshowList :: [ConfigResetOptions] -> ShowS
show :: ConfigResetOptions -> FilePath
$cshow :: ConfigResetOptions -> FilePath
showsPrec :: Int -> ConfigResetOptions -> ShowS
$cshowsPrec :: Int -> ConfigResetOptions -> ShowS
Show, ConfigResetOptions -> ConfigResetOptions -> Bool
(ConfigResetOptions -> ConfigResetOptions -> Bool)
-> (ConfigResetOptions -> ConfigResetOptions -> Bool)
-> Eq ConfigResetOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigResetOptions -> ConfigResetOptions -> Bool
$c/= :: ConfigResetOptions -> ConfigResetOptions -> Bool
== :: ConfigResetOptions -> ConfigResetOptions -> Bool
$c== :: ConfigResetOptions -> ConfigResetOptions -> Bool
Eq)

-- | Options for the "config set" command to be parsed from the command-line.
data ConfigSetOptions
  = ConfigSetOptions { ConfigSetOptions -> Text
setKey   :: T.Text
                     , ConfigSetOptions -> Text
setValue :: T.Text
                     }
  deriving (Int -> ConfigSetOptions -> ShowS
[ConfigSetOptions] -> ShowS
ConfigSetOptions -> FilePath
(Int -> ConfigSetOptions -> ShowS)
-> (ConfigSetOptions -> FilePath)
-> ([ConfigSetOptions] -> ShowS)
-> Show ConfigSetOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigSetOptions] -> ShowS
$cshowList :: [ConfigSetOptions] -> ShowS
show :: ConfigSetOptions -> FilePath
$cshow :: ConfigSetOptions -> FilePath
showsPrec :: Int -> ConfigSetOptions -> ShowS
$cshowsPrec :: Int -> ConfigSetOptions -> ShowS
Show, ConfigSetOptions -> ConfigSetOptions -> Bool
(ConfigSetOptions -> ConfigSetOptions -> Bool)
-> (ConfigSetOptions -> ConfigSetOptions -> Bool)
-> Eq ConfigSetOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigSetOptions -> ConfigSetOptions -> Bool
$c/= :: ConfigSetOptions -> ConfigSetOptions -> Bool
== :: ConfigSetOptions -> ConfigSetOptions -> Bool
$c== :: ConfigSetOptions -> ConfigSetOptions -> Bool
Eq)

-- | Options for the "config add-default" command to be parsed from the command-line.
data ConfigAddDefaultOptions
  = ConfigAddDefaultOptions { ConfigAddDefaultOptions -> FilePath
addDefaultDir  :: FilePath
                            , ConfigAddDefaultOptions -> Maybe Text
addDefaultName :: Maybe T.Text
                            }
  deriving (Int -> ConfigAddDefaultOptions -> ShowS
[ConfigAddDefaultOptions] -> ShowS
ConfigAddDefaultOptions -> FilePath
(Int -> ConfigAddDefaultOptions -> ShowS)
-> (ConfigAddDefaultOptions -> FilePath)
-> ([ConfigAddDefaultOptions] -> ShowS)
-> Show ConfigAddDefaultOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigAddDefaultOptions] -> ShowS
$cshowList :: [ConfigAddDefaultOptions] -> ShowS
show :: ConfigAddDefaultOptions -> FilePath
$cshow :: ConfigAddDefaultOptions -> FilePath
showsPrec :: Int -> ConfigAddDefaultOptions -> ShowS
$cshowsPrec :: Int -> ConfigAddDefaultOptions -> ShowS
Show, ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool
(ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool)
-> (ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool)
-> Eq ConfigAddDefaultOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool
$c/= :: ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool
== :: ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool
$c== :: ConfigAddDefaultOptions -> ConfigAddDefaultOptions -> Bool
Eq)

-- | Options for the "config" command to be parsed from the command-line.
data ConfigCommand
  = Print ConfigPrintOptions
  | Reset ConfigResetOptions
  | Set ConfigSetOptions
  | AddDefaultBookmark ConfigAddDefaultOptions
  deriving (Int -> ConfigCommand -> ShowS
[ConfigCommand] -> ShowS
ConfigCommand -> FilePath
(Int -> ConfigCommand -> ShowS)
-> (ConfigCommand -> FilePath)
-> ([ConfigCommand] -> ShowS)
-> Show ConfigCommand
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigCommand] -> ShowS
$cshowList :: [ConfigCommand] -> ShowS
show :: ConfigCommand -> FilePath
$cshow :: ConfigCommand -> FilePath
showsPrec :: Int -> ConfigCommand -> ShowS
$cshowsPrec :: Int -> ConfigCommand -> ShowS
Show, ConfigCommand -> ConfigCommand -> Bool
(ConfigCommand -> ConfigCommand -> Bool)
-> (ConfigCommand -> ConfigCommand -> Bool) -> Eq ConfigCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigCommand -> ConfigCommand -> Bool
$c/= :: ConfigCommand -> ConfigCommand -> Bool
== :: ConfigCommand -> ConfigCommand -> Bool
$c== :: ConfigCommand -> ConfigCommand -> Bool
Eq)

-- | Options for the "check" command to be parsed from the command-line.
data CheckOptions
  = CheckOptions { CheckOptions -> Bool
checkConfig    :: Bool
                 , CheckOptions -> Bool
checkBookmarks :: Bool
                 }
  deriving (Int -> CheckOptions -> ShowS
[CheckOptions] -> ShowS
CheckOptions -> FilePath
(Int -> CheckOptions -> ShowS)
-> (CheckOptions -> FilePath)
-> ([CheckOptions] -> ShowS)
-> Show CheckOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CheckOptions] -> ShowS
$cshowList :: [CheckOptions] -> ShowS
show :: CheckOptions -> FilePath
$cshow :: CheckOptions -> FilePath
showsPrec :: Int -> CheckOptions -> ShowS
$cshowsPrec :: Int -> CheckOptions -> ShowS
Show, CheckOptions -> CheckOptions -> Bool
(CheckOptions -> CheckOptions -> Bool)
-> (CheckOptions -> CheckOptions -> Bool) -> Eq CheckOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckOptions -> CheckOptions -> Bool
$c/= :: CheckOptions -> CheckOptions -> Bool
== :: CheckOptions -> CheckOptions -> Bool
$c== :: CheckOptions -> CheckOptions -> Bool
Eq)

-- | Options for the "help" command to be parsed from the command-line.
newtype HelpOptions
  = HelpOptions { HelpOptions -> Maybe Text
helpSubcommand :: Maybe T.Text }
  deriving (Int -> HelpOptions -> ShowS
[HelpOptions] -> ShowS
HelpOptions -> FilePath
(Int -> HelpOptions -> ShowS)
-> (HelpOptions -> FilePath)
-> ([HelpOptions] -> ShowS)
-> Show HelpOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HelpOptions] -> ShowS
$cshowList :: [HelpOptions] -> ShowS
show :: HelpOptions -> FilePath
$cshow :: HelpOptions -> FilePath
showsPrec :: Int -> HelpOptions -> ShowS
$cshowsPrec :: Int -> HelpOptions -> ShowS
Show, HelpOptions -> HelpOptions -> Bool
(HelpOptions -> HelpOptions -> Bool)
-> (HelpOptions -> HelpOptions -> Bool) -> Eq HelpOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelpOptions -> HelpOptions -> Bool
$c/= :: HelpOptions -> HelpOptions -> Bool
== :: HelpOptions -> HelpOptions -> Bool
$c== :: HelpOptions -> HelpOptions -> Bool
Eq)

-- | The core data-type for the hoyo CLI. The 'Command' is parsed from the command-line,
-- then 'Hoyo.Command.runCommand' dispatches on the type.
data Command
  = Add AddOptions
  | Move MoveOptions
  | List ListOptions
  | Clear ClearOptions
  | Delete DeleteOptions
  | Refresh RefreshOptions
  | ConfigCmd ConfigCommand
  | Check CheckOptions
  | DefaultCommand
  | Help HelpOptions
  deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> FilePath
(Int -> Command -> ShowS)
-> (Command -> FilePath) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> FilePath
$cshow :: Command -> FilePath
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq)

-- | Datatype for representing a command-line settings override.
data MaybeOverride = OverrideFalse | OverrideTrue | NoOverride | Conflict deriving
  ( Int -> MaybeOverride -> ShowS
[MaybeOverride] -> ShowS
MaybeOverride -> FilePath
(Int -> MaybeOverride -> ShowS)
-> (MaybeOverride -> FilePath)
-> ([MaybeOverride] -> ShowS)
-> Show MaybeOverride
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MaybeOverride] -> ShowS
$cshowList :: [MaybeOverride] -> ShowS
show :: MaybeOverride -> FilePath
$cshow :: MaybeOverride -> FilePath
showsPrec :: Int -> MaybeOverride -> ShowS
$cshowsPrec :: Int -> MaybeOverride -> ShowS
Show
  , MaybeOverride -> MaybeOverride -> Bool
(MaybeOverride -> MaybeOverride -> Bool)
-> (MaybeOverride -> MaybeOverride -> Bool) -> Eq MaybeOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaybeOverride -> MaybeOverride -> Bool
$c/= :: MaybeOverride -> MaybeOverride -> Bool
== :: MaybeOverride -> MaybeOverride -> Bool
$c== :: MaybeOverride -> MaybeOverride -> Bool
Eq
  )

-- | Config settings that can be overriden using command-line flags.
data OverrideOptions
  = OverrideOptions { OverrideOptions -> MaybeOverride
overrideFailOnError         :: MaybeOverride
                    , OverrideOptions -> MaybeOverride
overrideDisplayCreationTime :: MaybeOverride
                    , OverrideOptions -> MaybeOverride
overrideEnableClearing      :: MaybeOverride
                    , OverrideOptions -> MaybeOverride
overrideEnableReset         :: MaybeOverride
                    , OverrideOptions -> MaybeOverride
overrideBackupBeforeClear   :: MaybeOverride
                    }
  deriving (Int -> OverrideOptions -> ShowS
[OverrideOptions] -> ShowS
OverrideOptions -> FilePath
(Int -> OverrideOptions -> ShowS)
-> (OverrideOptions -> FilePath)
-> ([OverrideOptions] -> ShowS)
-> Show OverrideOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OverrideOptions] -> ShowS
$cshowList :: [OverrideOptions] -> ShowS
show :: OverrideOptions -> FilePath
$cshow :: OverrideOptions -> FilePath
showsPrec :: Int -> OverrideOptions -> ShowS
$cshowsPrec :: Int -> OverrideOptions -> ShowS
Show, OverrideOptions -> OverrideOptions -> Bool
(OverrideOptions -> OverrideOptions -> Bool)
-> (OverrideOptions -> OverrideOptions -> Bool)
-> Eq OverrideOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverrideOptions -> OverrideOptions -> Bool
$c/= :: OverrideOptions -> OverrideOptions -> Bool
== :: OverrideOptions -> OverrideOptions -> Bool
$c== :: OverrideOptions -> OverrideOptions -> Bool
Eq)

-- | CLI options that can be set regardless of which command is run.
data GlobalOptions
  = GlobalOptions { GlobalOptions -> Maybe FilePath
globalConfigPath :: Maybe FilePath
                  , GlobalOptions -> Maybe FilePath
dataPath         :: Maybe FilePath
                  , GlobalOptions -> OverrideOptions
overrides        :: OverrideOptions
                  }
  deriving (Int -> GlobalOptions -> ShowS
[GlobalOptions] -> ShowS
GlobalOptions -> FilePath
(Int -> GlobalOptions -> ShowS)
-> (GlobalOptions -> FilePath)
-> ([GlobalOptions] -> ShowS)
-> Show GlobalOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GlobalOptions] -> ShowS
$cshowList :: [GlobalOptions] -> ShowS
show :: GlobalOptions -> FilePath
$cshow :: GlobalOptions -> FilePath
showsPrec :: Int -> GlobalOptions -> ShowS
$cshowsPrec :: Int -> GlobalOptions -> ShowS
Show, GlobalOptions -> GlobalOptions -> Bool
(GlobalOptions -> GlobalOptions -> Bool)
-> (GlobalOptions -> GlobalOptions -> Bool) -> Eq GlobalOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalOptions -> GlobalOptions -> Bool
$c/= :: GlobalOptions -> GlobalOptions -> Bool
== :: GlobalOptions -> GlobalOptions -> Bool
$c== :: GlobalOptions -> GlobalOptions -> Bool
Eq)

-- | The final result of parsing the CLI arguments. Contains a command and all
-- information for that command, and any global options that have been set.
data Options
  = Options { Options -> Command
optCommand :: Command
            , Options -> GlobalOptions
optGlobals :: GlobalOptions
            }
  deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> FilePath
(Int -> Options -> ShowS)
-> (Options -> FilePath) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> FilePath
$cshow :: Options -> FilePath
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show, Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq)

makeLenses ''Bookmark
makeLenses ''DefaultBookmark
makeLenses ''Env
flip makeLensesWith ''Config $
  lensRules
    & lensField .~ \_ _ n -> [TopName $ mkName $ '_' : nameBase n]