{-# LANGUAGE DeriveGeneric #-}
module Photoname.Common
( Artist (..)
, ConfigPath (..)
, CopySwitch (..)
, DestPath (..)
, Links(..)
, MoveSwitch (..)
, NoActionSwitch (..)
, NoDirsSwitch (..)
, ParentDir (..)
, Options (..)
, Ph
, Prefix (..)
, SrcPath (..)
, Suffix (..)
, Verbosity (..)
, readVerbosity
, runRename
, MonadError
, ask, asks
, liftIO
, throwError
)
where
import Control.Monad.Except ( ExceptT, MonadError, runExceptT, throwError )
import Control.Monad.Reader ( ReaderT, ask, asks, runReaderT )
import Control.Monad.Trans ( liftIO )
import Control.Newtype.Generics
import GHC.Generics
import System.Log.Logger ( Priority (..) )
import System.Posix ( CNlink )
data Verbosity
= Quiet
| Verbose Priority
instance Show Verbosity where
show :: Verbosity -> String
show Verbosity
Quiet = String
"0"
show (Verbose Priority
NOTICE) = String
"1"
show (Verbose Priority
INFO) = String
"2"
show (Verbose Priority
DEBUG) = String
"3"
show Verbosity
_ = String
"Should never see this, invalid verbosity level being shown"
readVerbosity :: String -> Either String Verbosity
readVerbosity :: String -> Either String Verbosity
readVerbosity String
"0" = Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
Quiet
readVerbosity String
"1" = Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right (Verbosity -> Either String Verbosity)
-> Verbosity -> Either String Verbosity
forall a b. (a -> b) -> a -> b
$ Priority -> Verbosity
Verbose Priority
NOTICE
readVerbosity String
"2" = Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right (Verbosity -> Either String Verbosity)
-> Verbosity -> Either String Verbosity
forall a b. (a -> b) -> a -> b
$ Priority -> Verbosity
Verbose Priority
INFO
readVerbosity String
"3" = Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right (Verbosity -> Either String Verbosity)
-> Verbosity -> Either String Verbosity
forall a b. (a -> b) -> a -> b
$ Priority -> Verbosity
Verbose Priority
DEBUG
readVerbosity String
_ = String -> Either String Verbosity
forall a b. a -> Either a b
Left String
"Invalid verbosity level, expecting 0-3"
newtype Artist = Artist String
newtype ConfigPath = ConfigPath FilePath
newtype CopySwitch = CopySwitch Bool
deriving (forall x. CopySwitch -> Rep CopySwitch x)
-> (forall x. Rep CopySwitch x -> CopySwitch) -> Generic CopySwitch
forall x. Rep CopySwitch x -> CopySwitch
forall x. CopySwitch -> Rep CopySwitch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopySwitch x -> CopySwitch
$cfrom :: forall x. CopySwitch -> Rep CopySwitch x
Generic
instance Newtype CopySwitch
newtype = Bool
deriving (forall x. NoDirsSwitch -> Rep NoDirsSwitch x)
-> (forall x. Rep NoDirsSwitch x -> NoDirsSwitch)
-> Generic NoDirsSwitch
forall x. Rep NoDirsSwitch x -> NoDirsSwitch
forall x. NoDirsSwitch -> Rep NoDirsSwitch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoDirsSwitch x -> NoDirsSwitch
$cfrom :: forall x. NoDirsSwitch -> Rep NoDirsSwitch x
Generic
instance Newtype NoDirsSwitch
data Links = Exactly CNlink | NoLimit
newtype MoveSwitch = MoveSwitch Bool
deriving (forall x. MoveSwitch -> Rep MoveSwitch x)
-> (forall x. Rep MoveSwitch x -> MoveSwitch) -> Generic MoveSwitch
forall x. Rep MoveSwitch x -> MoveSwitch
forall x. MoveSwitch -> Rep MoveSwitch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MoveSwitch x -> MoveSwitch
$cfrom :: forall x. MoveSwitch -> Rep MoveSwitch x
Generic
instance Newtype MoveSwitch
newtype NoActionSwitch = NoActionSwitch Bool
deriving (forall x. NoActionSwitch -> Rep NoActionSwitch x)
-> (forall x. Rep NoActionSwitch x -> NoActionSwitch)
-> Generic NoActionSwitch
forall x. Rep NoActionSwitch x -> NoActionSwitch
forall x. NoActionSwitch -> Rep NoActionSwitch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoActionSwitch x -> NoActionSwitch
$cfrom :: forall x. NoActionSwitch -> Rep NoActionSwitch x
Generic
instance Newtype NoActionSwitch
newtype ParentDir = ParentDir FilePath
deriving (forall x. ParentDir -> Rep ParentDir x)
-> (forall x. Rep ParentDir x -> ParentDir) -> Generic ParentDir
forall x. Rep ParentDir x -> ParentDir
forall x. ParentDir -> Rep ParentDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParentDir x -> ParentDir
$cfrom :: forall x. ParentDir -> Rep ParentDir x
Generic
instance Newtype ParentDir
newtype Prefix = Prefix String
deriving (forall x. Prefix -> Rep Prefix x)
-> (forall x. Rep Prefix x -> Prefix) -> Generic Prefix
forall x. Rep Prefix x -> Prefix
forall x. Prefix -> Rep Prefix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prefix x -> Prefix
$cfrom :: forall x. Prefix -> Rep Prefix x
Generic
instance Newtype Prefix
newtype Suffix = Suffix String
deriving (forall x. Suffix -> Rep Suffix x)
-> (forall x. Rep Suffix x -> Suffix) -> Generic Suffix
forall x. Rep Suffix x -> Suffix
forall x. Suffix -> Rep Suffix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Suffix x -> Suffix
$cfrom :: forall x. Suffix -> Rep Suffix x
Generic
instance Newtype Suffix
data Options = Options
{ Options -> Maybe Artist
optArtist :: Maybe Artist
, Options -> Maybe ConfigPath
optConfig :: Maybe ConfigPath
, Options -> CopySwitch
optCopy :: CopySwitch
, Options -> NoDirsSwitch
optNoDirs :: NoDirsSwitch
, Options -> Links
optLinks :: Links
, Options -> MoveSwitch
optMove :: MoveSwitch
, Options -> NoActionSwitch
optNoAction :: NoActionSwitch
, Options -> ParentDir
optParentDir :: ParentDir
, Options -> Prefix
optPrefix :: Prefix
, Options -> Suffix
optSuffix :: Suffix
, Options -> Verbosity
optVerbosity :: Verbosity
, Options -> [String]
optPaths :: [FilePath]
}
newtype SrcPath = SrcPath FilePath
deriving (forall x. SrcPath -> Rep SrcPath x)
-> (forall x. Rep SrcPath x -> SrcPath) -> Generic SrcPath
forall x. Rep SrcPath x -> SrcPath
forall x. SrcPath -> Rep SrcPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcPath x -> SrcPath
$cfrom :: forall x. SrcPath -> Rep SrcPath x
Generic
instance Newtype SrcPath
newtype DestPath = DestPath FilePath
deriving (forall x. DestPath -> Rep DestPath x)
-> (forall x. Rep DestPath x -> DestPath) -> Generic DestPath
forall x. Rep DestPath x -> DestPath
forall x. DestPath -> Rep DestPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DestPath x -> DestPath
$cfrom :: forall x. DestPath -> Rep DestPath x
Generic
instance Newtype DestPath
type Ph a = ReaderT Options (ExceptT String IO) a
runRename :: Options -> Ph a -> IO (Either String a)
runRename :: Options -> Ph a -> IO (Either String a)
runRename Options
env Ph a
action = ExceptT String IO a -> IO (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO a -> IO (Either String a))
-> ExceptT String IO a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ Ph a -> Options -> ExceptT String IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Ph a
action Options
env