{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE QuasiQuotes #-}
module Monatone.Writer
(
WriteError(..)
, Writer
, MetadataUpdate(..)
, emptyUpdate
, setTitle
, setArtist
, setAlbum
, setAlbumArtist
, setTrackNumber
, setDiscNumber
, setYear
, setDate
, setGenre
, setPublisher
, setComment
, setReleaseCountry
, setLabel
, setCatalogNumber
, setBarcode
, setAlbumArt
, clearTitle
, clearArtist
, clearAlbum
, clearComment
, removeAlbumArt
, writeMetadata
, writeMetadataToFile
, updateMetadata
) where
import Control.Monad.Except (ExceptT, throwError, runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import qualified Data.Text as T
import System.OsPath
import System.Directory.OsPath (renameFile, removeFile)
import System.File.OsPath (readFile', writeFile')
import Control.Exception (try, IOException, evaluate)
import Monatone.Metadata
import Monatone.Types (Parser, ParseError(..))
import Monatone.Common (loadAlbumArt)
import qualified Monatone.MP3 as MP3
import qualified Monatone.FLAC as FLAC
import qualified Monatone.MP3.Writer as MP3Writer
import qualified Monatone.FLAC.Writer as FLACWriter
data WriteError
= WriteIOError Text
| UnsupportedWriteFormat AudioFormat
| InvalidMetadata Text
| CorruptedWrite Text
deriving (Int -> WriteError -> ShowS
[WriteError] -> ShowS
WriteError -> String
(Int -> WriteError -> ShowS)
-> (WriteError -> String)
-> ([WriteError] -> ShowS)
-> Show WriteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteError -> ShowS
showsPrec :: Int -> WriteError -> ShowS
$cshow :: WriteError -> String
show :: WriteError -> String
$cshowList :: [WriteError] -> ShowS
showList :: [WriteError] -> ShowS
Show, WriteError -> WriteError -> Bool
(WriteError -> WriteError -> Bool)
-> (WriteError -> WriteError -> Bool) -> Eq WriteError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriteError -> WriteError -> Bool
== :: WriteError -> WriteError -> Bool
$c/= :: WriteError -> WriteError -> Bool
/= :: WriteError -> WriteError -> Bool
Eq)
type Writer = ExceptT WriteError IO
data MetadataUpdate = MetadataUpdate
{ MetadataUpdate -> Maybe (Maybe Text)
updateTitle :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateArtist :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateAlbum :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateAlbumArtist :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Int)
updateTrackNumber :: Maybe (Maybe Int)
, MetadataUpdate -> Maybe (Maybe Int)
updateDiscNumber :: Maybe (Maybe Int)
, MetadataUpdate -> Maybe (Maybe Int)
updateYear :: Maybe (Maybe Int)
, MetadataUpdate -> Maybe (Maybe Text)
updateDate :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateGenre :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updatePublisher :: Maybe (Maybe Text)
, :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateReleaseCountry :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateRecordLabel :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateCatalogNumber :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe Text)
updateBarcode :: Maybe (Maybe Text)
, MetadataUpdate -> Maybe (Maybe AlbumArt)
updateAlbumArt :: Maybe (Maybe AlbumArt)
} deriving (Int -> MetadataUpdate -> ShowS
[MetadataUpdate] -> ShowS
MetadataUpdate -> String
(Int -> MetadataUpdate -> ShowS)
-> (MetadataUpdate -> String)
-> ([MetadataUpdate] -> ShowS)
-> Show MetadataUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataUpdate -> ShowS
showsPrec :: Int -> MetadataUpdate -> ShowS
$cshow :: MetadataUpdate -> String
show :: MetadataUpdate -> String
$cshowList :: [MetadataUpdate] -> ShowS
showList :: [MetadataUpdate] -> ShowS
Show, MetadataUpdate -> MetadataUpdate -> Bool
(MetadataUpdate -> MetadataUpdate -> Bool)
-> (MetadataUpdate -> MetadataUpdate -> Bool) -> Eq MetadataUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataUpdate -> MetadataUpdate -> Bool
== :: MetadataUpdate -> MetadataUpdate -> Bool
$c/= :: MetadataUpdate -> MetadataUpdate -> Bool
/= :: MetadataUpdate -> MetadataUpdate -> Bool
Eq)
emptyUpdate :: MetadataUpdate
emptyUpdate :: MetadataUpdate
emptyUpdate = MetadataUpdate
{ updateTitle :: Maybe (Maybe Text)
updateTitle = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateArtist :: Maybe (Maybe Text)
updateArtist = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateAlbum :: Maybe (Maybe Text)
updateAlbum = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateAlbumArtist :: Maybe (Maybe Text)
updateAlbumArtist = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateTrackNumber :: Maybe (Maybe Int)
updateTrackNumber = Maybe (Maybe Int)
forall a. Maybe a
Nothing
, updateDiscNumber :: Maybe (Maybe Int)
updateDiscNumber = Maybe (Maybe Int)
forall a. Maybe a
Nothing
, updateYear :: Maybe (Maybe Int)
updateYear = Maybe (Maybe Int)
forall a. Maybe a
Nothing
, updateDate :: Maybe (Maybe Text)
updateDate = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateGenre :: Maybe (Maybe Text)
updateGenre = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updatePublisher :: Maybe (Maybe Text)
updatePublisher = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateComment :: Maybe (Maybe Text)
updateComment = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateReleaseCountry :: Maybe (Maybe Text)
updateReleaseCountry = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateRecordLabel :: Maybe (Maybe Text)
updateRecordLabel = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateCatalogNumber :: Maybe (Maybe Text)
updateCatalogNumber = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateBarcode :: Maybe (Maybe Text)
updateBarcode = Maybe (Maybe Text)
forall a. Maybe a
Nothing
, updateAlbumArt :: Maybe (Maybe AlbumArt)
updateAlbumArt = Maybe (Maybe AlbumArt)
forall a. Maybe a
Nothing
}
setTitle :: Text -> MetadataUpdate -> MetadataUpdate
setTitle :: Text -> MetadataUpdate -> MetadataUpdate
setTitle Text
newTitle MetadataUpdate
update = MetadataUpdate
update { updateTitle = Just (Just newTitle) }
setArtist :: Text -> MetadataUpdate -> MetadataUpdate
setArtist :: Text -> MetadataUpdate -> MetadataUpdate
setArtist Text
newArtist MetadataUpdate
update = MetadataUpdate
update { updateArtist = Just (Just newArtist) }
setAlbum :: Text -> MetadataUpdate -> MetadataUpdate
setAlbum :: Text -> MetadataUpdate -> MetadataUpdate
setAlbum Text
newAlbum MetadataUpdate
update = MetadataUpdate
update { updateAlbum = Just (Just newAlbum) }
setAlbumArtist :: Text -> MetadataUpdate -> MetadataUpdate
setAlbumArtist :: Text -> MetadataUpdate -> MetadataUpdate
setAlbumArtist Text
newAlbumArtist MetadataUpdate
update = MetadataUpdate
update { updateAlbumArtist = Just (Just newAlbumArtist) }
setTrackNumber :: Int -> MetadataUpdate -> MetadataUpdate
setTrackNumber :: Int -> MetadataUpdate -> MetadataUpdate
setTrackNumber Int
newTrackNumber MetadataUpdate
update = MetadataUpdate
update { updateTrackNumber = Just (Just newTrackNumber) }
setDiscNumber :: Int -> MetadataUpdate -> MetadataUpdate
setDiscNumber :: Int -> MetadataUpdate -> MetadataUpdate
setDiscNumber Int
newDiscNumber MetadataUpdate
update = MetadataUpdate
update { updateDiscNumber = Just (Just newDiscNumber) }
setYear :: Int -> MetadataUpdate -> MetadataUpdate
setYear :: Int -> MetadataUpdate -> MetadataUpdate
setYear Int
newYear MetadataUpdate
update = MetadataUpdate
update { updateYear = Just (Just newYear) }
setGenre :: Text -> MetadataUpdate -> MetadataUpdate
setGenre :: Text -> MetadataUpdate -> MetadataUpdate
setGenre Text
newGenre MetadataUpdate
update = MetadataUpdate
update { updateGenre = Just (Just newGenre) }
setPublisher :: Text -> MetadataUpdate -> MetadataUpdate
setPublisher :: Text -> MetadataUpdate -> MetadataUpdate
setPublisher Text
newPublisher MetadataUpdate
update = MetadataUpdate
update { updatePublisher = Just (Just newPublisher) }
setComment :: Text -> MetadataUpdate -> MetadataUpdate
Text
newComment MetadataUpdate
update = MetadataUpdate
update { updateComment = Just (Just newComment) }
setAlbumArt :: AlbumArt -> MetadataUpdate -> MetadataUpdate
setAlbumArt :: AlbumArt -> MetadataUpdate -> MetadataUpdate
setAlbumArt AlbumArt
art MetadataUpdate
update = MetadataUpdate
update { updateAlbumArt = Just (Just art) }
setDate :: Text -> MetadataUpdate -> MetadataUpdate
setDate :: Text -> MetadataUpdate -> MetadataUpdate
setDate Text
newDate MetadataUpdate
update = MetadataUpdate
update { updateDate = Just (Just newDate) }
setReleaseCountry :: Text -> MetadataUpdate -> MetadataUpdate
setReleaseCountry :: Text -> MetadataUpdate -> MetadataUpdate
setReleaseCountry Text
newCountry MetadataUpdate
update = MetadataUpdate
update { updateReleaseCountry = Just (Just newCountry) }
setLabel :: Text -> MetadataUpdate -> MetadataUpdate
setLabel :: Text -> MetadataUpdate -> MetadataUpdate
setLabel Text
newLabel MetadataUpdate
update = MetadataUpdate
update { updateRecordLabel = Just (Just newLabel) }
setCatalogNumber :: Text -> MetadataUpdate -> MetadataUpdate
setCatalogNumber :: Text -> MetadataUpdate -> MetadataUpdate
setCatalogNumber Text
newCatalog MetadataUpdate
update = MetadataUpdate
update { updateCatalogNumber = Just (Just newCatalog) }
setBarcode :: Text -> MetadataUpdate -> MetadataUpdate
setBarcode :: Text -> MetadataUpdate -> MetadataUpdate
setBarcode Text
newBarcode MetadataUpdate
update = MetadataUpdate
update { updateBarcode = Just (Just newBarcode) }
clearTitle :: MetadataUpdate -> MetadataUpdate
clearTitle :: MetadataUpdate -> MetadataUpdate
clearTitle MetadataUpdate
update = MetadataUpdate
update { updateTitle = Just Nothing }
clearArtist :: MetadataUpdate -> MetadataUpdate
clearArtist :: MetadataUpdate -> MetadataUpdate
clearArtist MetadataUpdate
update = MetadataUpdate
update { updateArtist = Just Nothing }
clearAlbum :: MetadataUpdate -> MetadataUpdate
clearAlbum :: MetadataUpdate -> MetadataUpdate
clearAlbum MetadataUpdate
update = MetadataUpdate
update { updateAlbum = Just Nothing }
clearComment :: MetadataUpdate -> MetadataUpdate
MetadataUpdate
update = MetadataUpdate
update { updateComment = Just Nothing }
removeAlbumArt :: MetadataUpdate -> MetadataUpdate
removeAlbumArt :: MetadataUpdate -> MetadataUpdate
removeAlbumArt MetadataUpdate
update = MetadataUpdate
update { updateAlbumArt = Just Nothing }
applyUpdate :: MetadataUpdate -> Metadata -> Metadata
applyUpdate :: MetadataUpdate -> Metadata -> Metadata
applyUpdate MetadataUpdate
update Metadata
metadata =
let !fmt :: AudioFormat
fmt = Metadata -> AudioFormat
format Metadata
metadata
!props :: AudioProperties
props = Metadata -> AudioProperties
audioProperties Metadata
metadata
!mbids :: MusicBrainzIds
mbids = Metadata -> MusicBrainzIds
musicBrainzIds Metadata
metadata
!acoustFP :: Maybe Text
acoustFP = Metadata -> Maybe Text
acoustidFingerprint Metadata
metadata
!acoustID :: Maybe Text
acoustID = Metadata -> Maybe Text
acoustidId Metadata
metadata
!tags :: HashMap Text Text
tags = Metadata -> HashMap Text Text
rawTags Metadata
metadata
!totTracks :: Maybe Int
totTracks = Metadata -> Maybe Int
totalTracks Metadata
metadata
!totDiscs :: Maybe Int
totDiscs = Metadata -> Maybe Int
totalDiscs Metadata
metadata
!relStatus :: Maybe Text
relStatus = Metadata -> Maybe Text
releaseStatus Metadata
metadata
!relType :: Maybe Text
relType = Metadata -> Maybe Text
releaseType Metadata
metadata
!artInfo :: Maybe AlbumArtInfo
artInfo = Metadata -> Maybe AlbumArtInfo
albumArtInfo Metadata
metadata
in Metadata
{ format :: AudioFormat
format = AudioFormat
fmt
, title :: Maybe Text
title = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateTitle MetadataUpdate
update) (Metadata -> Maybe Text
title Metadata
metadata)
, artist :: Maybe Text
artist = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateArtist MetadataUpdate
update) (Metadata -> Maybe Text
artist Metadata
metadata)
, album :: Maybe Text
album = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateAlbum MetadataUpdate
update) (Metadata -> Maybe Text
album Metadata
metadata)
, albumArtist :: Maybe Text
albumArtist = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateAlbumArtist MetadataUpdate
update) (Metadata -> Maybe Text
albumArtist Metadata
metadata)
, trackNumber :: Maybe Int
trackNumber = Maybe (Maybe Int) -> Maybe Int -> Maybe Int
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Int)
updateTrackNumber MetadataUpdate
update) (Metadata -> Maybe Int
trackNumber Metadata
metadata)
, totalTracks :: Maybe Int
totalTracks = Maybe Int
totTracks
, discNumber :: Maybe Int
discNumber = Maybe (Maybe Int) -> Maybe Int -> Maybe Int
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Int)
updateDiscNumber MetadataUpdate
update) (Metadata -> Maybe Int
discNumber Metadata
metadata)
, totalDiscs :: Maybe Int
totalDiscs = Maybe Int
totDiscs
, date :: Maybe Text
date = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateDate MetadataUpdate
update) (Metadata -> Maybe Text
date Metadata
metadata)
, year :: Maybe Int
year = Maybe (Maybe Int) -> Maybe Int -> Maybe Int
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Int)
updateYear MetadataUpdate
update) (Metadata -> Maybe Int
year Metadata
metadata)
, genre :: Maybe Text
genre = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateGenre MetadataUpdate
update) (Metadata -> Maybe Text
genre Metadata
metadata)
, publisher :: Maybe Text
publisher = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updatePublisher MetadataUpdate
update) (Metadata -> Maybe Text
publisher Metadata
metadata)
, comment :: Maybe Text
comment = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateComment MetadataUpdate
update) (Metadata -> Maybe Text
comment Metadata
metadata)
, releaseCountry :: Maybe Text
releaseCountry = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateReleaseCountry MetadataUpdate
update) (Metadata -> Maybe Text
releaseCountry Metadata
metadata)
, recordLabel :: Maybe Text
recordLabel = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateRecordLabel MetadataUpdate
update) (Metadata -> Maybe Text
recordLabel Metadata
metadata)
, catalogNumber :: Maybe Text
catalogNumber = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateCatalogNumber MetadataUpdate
update) (Metadata -> Maybe Text
catalogNumber Metadata
metadata)
, barcode :: Maybe Text
barcode = Maybe (Maybe Text) -> Maybe Text -> Maybe Text
forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate (MetadataUpdate -> Maybe (Maybe Text)
updateBarcode MetadataUpdate
update) (Metadata -> Maybe Text
barcode Metadata
metadata)
, releaseStatus :: Maybe Text
releaseStatus = Maybe Text
relStatus
, releaseType :: Maybe Text
releaseType = Maybe Text
relType
, albumArtInfo :: Maybe AlbumArtInfo
albumArtInfo = Maybe AlbumArtInfo
artInfo
, audioProperties :: AudioProperties
audioProperties = AudioProperties
props
, musicBrainzIds :: MusicBrainzIds
musicBrainzIds = MusicBrainzIds
mbids
, acoustidFingerprint :: Maybe Text
acoustidFingerprint = Maybe Text
acoustFP
, acoustidId :: Maybe Text
acoustidId = Maybe Text
acoustID
, rawTags :: HashMap Text Text
rawTags = HashMap Text Text
tags
}
where
applyMaybeUpdate :: Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate :: forall a. Maybe (Maybe a) -> Maybe a -> Maybe a
applyMaybeUpdate Maybe (Maybe a)
Nothing Maybe a
current = Maybe a
current
applyMaybeUpdate (Just Maybe a
newValue) Maybe a
_ = Maybe a
newValue
writeMetadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMetadata :: Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeMetadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath = do
let audioFormat :: AudioFormat
audioFormat = Metadata -> AudioFormat
format Metadata
metadata
case AudioFormat
audioFormat of
AudioFormat
MP3 -> Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeMP3Metadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath
AudioFormat
FLAC -> Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeFLACMetadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath
AudioFormat
_ -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ AudioFormat -> WriteError
UnsupportedWriteFormat AudioFormat
audioFormat
writeMetadataToFile :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMetadataToFile :: Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeMetadataToFile Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath = do
let backupPath :: OsString
backupPath = OsString
filePath OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> [osp|.backup|]
Either IOException ()
backupResult <- IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ())
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ()))
-> IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ do
ByteString
content <- OsString -> IO ByteString
readFile' OsString
filePath
OsString -> ByteString -> IO ()
writeFile' OsString
backupPath ByteString
content
case Either IOException ()
backupResult of
Left (IOException
ioErr :: IOException) -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
WriteIOError (Text -> WriteError) -> Text -> WriteError
forall a b. (a -> b) -> a -> b
$ Text
"Failed to create backup: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOException -> String
forall a. Show a => a -> String
show IOException
ioErr)
Right ()
_ -> do
Either WriteError ()
writeResult <- IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ())
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ()))
-> IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ Writer () -> IO (Either WriteError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Writer () -> IO (Either WriteError ()))
-> Writer () -> IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeMetadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath
case Either WriteError ()
writeResult of
Left WriteError
err -> do
Either IOException ()
restoreResult <- IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ())
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ()))
-> IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ OsString -> OsString -> IO ()
renameFile OsString
backupPath OsString
filePath
case Either IOException ()
restoreResult of
Left (IOException
restoreErr :: IOException) ->
WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
WriteIOError (Text -> WriteError) -> Text -> WriteError
forall a b. (a -> b) -> a -> b
$ Text
"Write failed and backup restore failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOException -> String
forall a. Show a => a -> String
show IOException
restoreErr)
Right ()
_ -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError WriteError
err
Right ()
_ -> do
Either IOException ()
cleanupResult <- IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ())
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ()))
-> IO (Either IOException ())
-> ExceptT WriteError IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ (IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try :: IO () -> IO (Either IOException ())) (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ OsString -> IO ()
removeFile OsString
backupPath
case Either IOException ()
cleanupResult of
Left IOException
_ -> () -> Writer ()
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right ()
_ -> () -> Writer ()
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateMetadata :: OsPath -> MetadataUpdate -> Writer ()
updateMetadata :: OsString -> MetadataUpdate -> Writer ()
updateMetadata OsString
filePath MetadataUpdate
update = do
Either ParseError Metadata
existingResult <- IO (Either ParseError Metadata)
-> ExceptT WriteError IO (Either ParseError Metadata)
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError Metadata)
-> ExceptT WriteError IO (Either ParseError Metadata))
-> IO (Either ParseError Metadata)
-> ExceptT WriteError IO (Either ParseError Metadata)
forall a b. (a -> b) -> a -> b
$ ExceptT ParseError IO Metadata -> IO (Either ParseError Metadata)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ParseError IO Metadata -> IO (Either ParseError Metadata))
-> ExceptT ParseError IO Metadata
-> IO (Either ParseError Metadata)
forall a b. (a -> b) -> a -> b
$ OsString -> ExceptT ParseError IO Metadata
parseFile OsString
filePath
case Either ParseError Metadata
existingResult of
Left ParseError
parseErr -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
CorruptedWrite (Text -> WriteError) -> Text -> WriteError
forall a b. (a -> b) -> a -> b
$ Text
"Failed to read existing metadata: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ParseError -> String
forall a. Show a => a -> String
show ParseError
parseErr)
Right Metadata
existingMetadata -> do
let updatedMetadata :: Metadata
updatedMetadata = MetadataUpdate -> Metadata -> Metadata
applyUpdate MetadataUpdate
update Metadata
existingMetadata
AudioFormat
_ <- IO AudioFormat -> ExceptT WriteError IO AudioFormat
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioFormat -> ExceptT WriteError IO AudioFormat)
-> IO AudioFormat -> ExceptT WriteError IO AudioFormat
forall a b. (a -> b) -> a -> b
$ AudioFormat -> IO AudioFormat
forall a. a -> IO a
evaluate (Metadata -> AudioFormat
format Metadata
updatedMetadata)
Maybe AlbumArt
maybeArt <- case MetadataUpdate -> Maybe (Maybe AlbumArt)
updateAlbumArt MetadataUpdate
update of
Just Maybe AlbumArt
Nothing -> Maybe AlbumArt -> ExceptT WriteError IO (Maybe AlbumArt)
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing
Just (Just AlbumArt
art) -> Maybe AlbumArt -> ExceptT WriteError IO (Maybe AlbumArt)
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AlbumArt -> Maybe AlbumArt
forall a. a -> Maybe a
Just AlbumArt
art)
Maybe (Maybe AlbumArt)
Nothing -> do
case Metadata -> Maybe AlbumArtInfo
albumArtInfo Metadata
existingMetadata of
Maybe AlbumArtInfo
Nothing -> Maybe AlbumArt -> ExceptT WriteError IO (Maybe AlbumArt)
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing
Just AlbumArtInfo
_ -> do
Either ParseError (Maybe AlbumArt)
artResult <- IO (Either ParseError (Maybe AlbumArt))
-> ExceptT WriteError IO (Either ParseError (Maybe AlbumArt))
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError (Maybe AlbumArt))
-> ExceptT WriteError IO (Either ParseError (Maybe AlbumArt)))
-> IO (Either ParseError (Maybe AlbumArt))
-> ExceptT WriteError IO (Either ParseError (Maybe AlbumArt))
forall a b. (a -> b) -> a -> b
$ OsString -> IO (Either ParseError (Maybe AlbumArt))
loadAlbumArt OsString
filePath
case Either ParseError (Maybe AlbumArt)
artResult of
Left ParseError
_ -> Maybe AlbumArt -> ExceptT WriteError IO (Maybe AlbumArt)
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing
Right Maybe AlbumArt
art -> Maybe AlbumArt -> ExceptT WriteError IO (Maybe AlbumArt)
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
art
Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeMetadataToFile Metadata
updatedMetadata Maybe AlbumArt
maybeArt OsString
filePath
writeMP3Metadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMP3Metadata :: Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeMP3Metadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath = do
Either WriteError ()
result <- IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ())
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ()))
-> IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ ExceptT WriteError IO () -> IO (Either WriteError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT WriteError IO () -> IO (Either WriteError ()))
-> ExceptT WriteError IO () -> IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ Metadata -> Maybe AlbumArt -> OsString -> ExceptT WriteError IO ()
MP3Writer.writeMP3Metadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath
case Either WriteError ()
result of
Left WriteError
mp3Err -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ WriteError -> WriteError
convertMP3Error WriteError
mp3Err
Right () -> () -> Writer ()
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
convertMP3Error :: MP3Writer.WriteError -> WriteError
convertMP3Error :: WriteError -> WriteError
convertMP3Error (MP3Writer.WriteIOError Text
msg) = Text -> WriteError
WriteIOError Text
msg
convertMP3Error (MP3Writer.UnsupportedWriteFormat AudioFormat
fmt) = AudioFormat -> WriteError
UnsupportedWriteFormat AudioFormat
fmt
convertMP3Error (MP3Writer.InvalidMetadata Text
msg) = Text -> WriteError
InvalidMetadata Text
msg
convertMP3Error (MP3Writer.CorruptedWrite Text
msg) = Text -> WriteError
CorruptedWrite Text
msg
writeFLACMetadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeFLACMetadata :: Metadata -> Maybe AlbumArt -> OsString -> Writer ()
writeFLACMetadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath = do
Either WriteError ()
result <- IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ())
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ()))
-> IO (Either WriteError ())
-> ExceptT WriteError IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ ExceptT WriteError IO () -> IO (Either WriteError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT WriteError IO () -> IO (Either WriteError ()))
-> ExceptT WriteError IO () -> IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ Metadata -> Maybe AlbumArt -> OsString -> ExceptT WriteError IO ()
FLACWriter.writeFLACMetadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsString
filePath
case Either WriteError ()
result of
Left WriteError
flacErr -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ WriteError -> WriteError
convertFLACError WriteError
flacErr
Right () -> () -> Writer ()
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
convertFLACError :: FLACWriter.WriteError -> WriteError
convertFLACError :: WriteError -> WriteError
convertFLACError (FLACWriter.WriteIOError Text
msg) = Text -> WriteError
WriteIOError Text
msg
convertFLACError (FLACWriter.UnsupportedWriteFormat AudioFormat
fmt) = AudioFormat -> WriteError
UnsupportedWriteFormat AudioFormat
fmt
convertFLACError (FLACWriter.InvalidMetadata Text
msg) = Text -> WriteError
InvalidMetadata Text
msg
convertFLACError (FLACWriter.CorruptedWrite Text
msg) = Text -> WriteError
CorruptedWrite Text
msg
parseFile :: OsPath -> Parser Metadata
parseFile :: OsString -> ExceptT ParseError IO Metadata
parseFile OsString
filePath = do
let ext :: OsString
ext = OsString -> OsString
takeExtension OsString
filePath
if OsString
ext OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
== [osp|.mp3|] Bool -> Bool -> Bool
|| OsString
ext OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
== [osp|.MP3|]
then OsString -> ExceptT ParseError IO Metadata
MP3.parseMP3 OsString
filePath
else if OsString
ext OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
== [osp|.flac|] Bool -> Bool -> Bool
|| OsString
ext OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
== [osp|.FLAC|]
then OsString -> ExceptT ParseError IO Metadata
FLAC.parseFLAC OsString
filePath
else ParseError -> ExceptT ParseError IO Metadata
forall a. ParseError -> ExceptT ParseError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ParseError -> ExceptT ParseError IO Metadata)
-> ParseError -> ExceptT ParseError IO Metadata
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
UnsupportedFormat Text
"Unsupported file extension"