Common.hs

{-# LANGUAGE DeriveGeneric #-}

module Photoname.Common
  ( Artist (..)
  , ConfigPath (..)
  , CopySwitch (..)
  , DestPath (..)
  , MoveSwitch (..)
  , NoActionSwitch (..)
  , NoDirsSwitch (..)
  , ParentDir (..)
  , Options (..)
  , Ph
  , Prefix (..)
  , SrcPath (..)
  , Suffix (..)
  , Verbosity (..)
  , readVerbosity
  , runRename

  -- Re-exporting:
  , 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 (..) )


data Verbosity
  = Quiet
  | Verbose Priority

instance Show Verbosity where
  show Quiet = "0"
  show (Verbose NOTICE) = "1"
  show (Verbose INFO) = "2"
  show (Verbose DEBUG) = "3"
  show _ = "Should never see this, invalid verbosity level being shown"

readVerbosity :: String -> Either String Verbosity
readVerbosity "0" = Right   Quiet
readVerbosity "1" = Right $ Verbose NOTICE
readVerbosity "2" = Right $ Verbose INFO
readVerbosity "3" = Right $ Verbose DEBUG
readVerbosity _   = Left    "Invalid verbosity level, expecting 0-3"


newtype Artist = Artist String

newtype ConfigPath = ConfigPath FilePath

newtype CopySwitch = CopySwitch Bool
  deriving Generic

instance Newtype CopySwitch

newtype NoDirsSwitch = NoDirsSwitch Bool
  deriving Generic

instance Newtype NoDirsSwitch

newtype MoveSwitch = MoveSwitch Bool
  deriving Generic

instance Newtype MoveSwitch

newtype NoActionSwitch = NoActionSwitch Bool
  deriving Generic

instance Newtype NoActionSwitch

newtype ParentDir = ParentDir FilePath
  deriving Generic

instance Newtype ParentDir

newtype Prefix = Prefix String
  deriving Generic

instance Newtype Prefix

newtype Suffix = Suffix String
  deriving Generic

instance Newtype Suffix

data Options = Options
  { optArtist     :: Maybe Artist
  , optConfig     :: Maybe ConfigPath
  , optCopy       :: CopySwitch
  , optNoDirs     :: NoDirsSwitch
  , optMove       :: MoveSwitch
  , optNoAction   :: NoActionSwitch
  , optParentDir  :: ParentDir
  , optPrefix     :: Prefix
  , optSuffix     :: Suffix
  , optVerbosity  :: Verbosity
  , optPaths      :: [FilePath]
  }


newtype SrcPath = SrcPath FilePath
  deriving Generic

instance Newtype SrcPath

newtype DestPath = DestPath FilePath
  deriving Generic

instance Newtype DestPath


type Ph a = ReaderT Options (ExceptT String IO) a


runRename :: Options -> Ph a -> IO (Either String a)
runRename env action = runExceptT $ runReaderT action env