{-# LANGUAGE DuplicateRecordFields #-}
module Photoname.Common
( Artist (..)
, ConfigPath (..)
, CopySwitch (..)
, DestPath (..)
, Extension (..)
, Links(..)
, MoveSwitch (..)
, NoActionSwitch (..)
, NoDirsSwitch (..)
, ParentDir (..)
, Options (..)
, Ph
, Prefix (..)
, SrcPath (..)
, Suffix (..)
, Verbosity (..)
, defaultDateTimeFormat
, 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 Data.Time.LocalTime (LocalTime)
import System.Log.Logger (Priority (..))
import System.Posix (CNlink)
defaultDateTimeFormat :: String
defaultDateTimeFormat :: String
defaultDateTimeFormat = String
"%Y%m%d-%H%M%S"
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 { CopySwitch -> Bool
v :: Bool }
type DateFormatter = LocalTime -> String
newtype = { :: Bool }
data Extension = Extension FilePath | UseExistingExtension
data Links = Exactly CNlink | NoLimit
newtype MoveSwitch = MoveSwitch { MoveSwitch -> Bool
v :: Bool }
newtype NoActionSwitch = NoActionSwitch { NoActionSwitch -> Bool
v :: Bool }
newtype ParentDir = ParentDir { ParentDir -> String
v :: FilePath }
newtype Prefix = Prefix { Prefix -> String
v :: String }
newtype Suffix = Suffix { Suffix -> String
v :: String }
data Options = Options
{ Options -> Maybe Artist
artist :: Maybe Artist
, Options -> Maybe ConfigPath
config :: Maybe ConfigPath
, Options -> CopySwitch
copy :: CopySwitch
, Options -> NoDirsSwitch
noDirs :: NoDirsSwitch
, Options -> Extension
extension :: Extension
, Options -> DateFormatter
formatter :: DateFormatter
, Options -> Links
links :: Links
, Options -> MoveSwitch
move :: MoveSwitch
, Options -> NoActionSwitch
noAction :: NoActionSwitch
, Options -> ParentDir
parentDir :: ParentDir
, Options -> Prefix
prefix :: Prefix
, Options -> Suffix
suffix :: Suffix
, Options -> Verbosity
verbosity :: Verbosity
, Options -> [String]
paths :: [FilePath]
}
newtype SrcPath = SrcPath { SrcPath -> String
v :: FilePath }
newtype DestPath = DestPath FilePath
type Ph a = ReaderT Options (ExceptT String IO) a
runRename :: Options -> Ph a -> IO (Either String a)
runRename :: forall a. 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