{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module ExifTool
(
ExifTool,
startExifTool,
stopExifTool,
withExifTool,
readMeta,
readMetaEither,
writeMeta,
writeMetaEither,
Metadata,
Tag (..),
stripGroups,
Value (..),
FromValue (..),
ToValue (..),
get,
set,
del,
)
where
import Control.Exception (bracket)
import Control.Monad (guard, void)
import Data.Aeson
( FromJSON (..),
FromJSONKey (..),
ToJSON (..),
ToJSONKey (..),
eitherDecode,
encode,
)
import qualified Data.Aeson as JSON
import Data.Aeson.Encoding.Internal (bool, list, scientific, text)
import Data.Bifunctor (bimap)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (decodeBase64, encodeBase64)
import qualified Data.ByteString.Lazy as BL
import Data.HashMap.Strict (HashMap, delete, insert, mapKeys, (!?))
import Data.Hashable (Hashable)
import Data.Scientific
( FPFormat (Fixed),
Scientific,
formatScientific,
fromFloatDigits,
isInteger,
toBoundedInteger,
toRealFloat,
)
import Data.Text
( Text,
intercalate,
isPrefixOf,
splitOn,
stripPrefix,
toCaseFold,
)
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Data.Text.IO (hGetLine, hPutStrLn)
import qualified Data.Vector as Vector
import System.IO (Handle, hFlush, hReady)
import System.IO.Temp (withSystemTempFile)
import System.Process
( ProcessHandle,
StdStream (CreatePipe),
cleanupProcess,
createProcess,
proc,
std_err,
std_in,
std_out,
)
import Witch (into)
data ExifTool
= ET
!Handle
!Handle
!Handle
!ProcessHandle
newtype Metadata = Metadata (HashMap Tag Value)
deriving (Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> FilePath
$cshow :: Metadata -> FilePath
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show, Metadata -> Metadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq)
deriving (NonEmpty Metadata -> Metadata
Metadata -> Metadata -> Metadata
forall b. Integral b => b -> Metadata -> Metadata
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Metadata -> Metadata
$cstimes :: forall b. Integral b => b -> Metadata -> Metadata
sconcat :: NonEmpty Metadata -> Metadata
$csconcat :: NonEmpty Metadata -> Metadata
<> :: Metadata -> Metadata -> Metadata
$c<> :: Metadata -> Metadata -> Metadata
Semigroup, Semigroup Metadata
Metadata
[Metadata] -> Metadata
Metadata -> Metadata -> Metadata
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Metadata] -> Metadata
$cmconcat :: [Metadata] -> Metadata
mappend :: Metadata -> Metadata -> Metadata
$cmappend :: Metadata -> Metadata -> Metadata
mempty :: Metadata
$cmempty :: Metadata
Monoid) via (HashMap Tag Value)
newtype Tag = Tag {Tag -> Text
tagName :: Text}
deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> FilePath
$cshow :: Tag -> FilePath
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, Tag -> Tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq)
deriving (Eq Tag
Int -> Tag -> Int
Tag -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Tag -> Int
$chash :: Tag -> Int
hashWithSalt :: Int -> Tag -> Int
$chashWithSalt :: Int -> Tag -> Int
Hashable, Value -> Parser [Tag]
Value -> Parser Tag
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Tag]
$cparseJSONList :: Value -> Parser [Tag]
parseJSON :: Value -> Parser Tag
$cparseJSON :: Value -> Parser Tag
FromJSON, FromJSONKeyFunction [Tag]
FromJSONKeyFunction Tag
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Tag]
$cfromJSONKeyList :: FromJSONKeyFunction [Tag]
fromJSONKey :: FromJSONKeyFunction Tag
$cfromJSONKey :: FromJSONKeyFunction Tag
FromJSONKey, [Tag] -> Encoding
[Tag] -> Value
Tag -> Encoding
Tag -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Tag] -> Encoding
$ctoEncodingList :: [Tag] -> Encoding
toJSONList :: [Tag] -> Value
$ctoJSONList :: [Tag] -> Value
toEncoding :: Tag -> Encoding
$ctoEncoding :: Tag -> Encoding
toJSON :: Tag -> Value
$ctoJSON :: Tag -> Value
ToJSON, ToJSONKeyFunction [Tag]
ToJSONKeyFunction Tag
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Tag]
$ctoJSONKeyList :: ToJSONKeyFunction [Tag]
toJSONKey :: ToJSONKeyFunction Tag
$ctoJSONKey :: ToJSONKeyFunction Tag
ToJSONKey) via Text
stripGroups :: Tag -> Tag
stripGroups :: Tag -> Tag
stripGroups = Text -> Tag
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
splitOn Text
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text
tagName
toLower :: Tag -> Tag
toLower :: Tag -> Tag
toLower = Text -> Tag
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toCaseFold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text
tagName
data Value
= String !Text
| Binary !ByteString
| Number !Scientific
| Bool !Bool
| List ![Value]
deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> FilePath
$cshow :: Value -> FilePath
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq)
instance FromJSON Value where
parseJSON :: Value -> Parser Value
parseJSON (JSON.String Text
x)
| Just Text
b <- Text -> Text -> Maybe Text
stripPrefix Text
"base64:" Text
x =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @String)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Value
Binary)
(ByteString -> Either Text ByteString
decodeBase64 forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
b)
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
x
parseJSON (JSON.Number Scientific
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
x
parseJSON (JSON.Bool Bool
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Value
Bool Bool
x
parseJSON (JSON.Array Array
xs) = [Value] -> Value
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vector.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON Array
xs
parseJSON Value
JSON.Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
""
parseJSON Value
x = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"error parsing ExifTool JSON output: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Value
x
instance ToJSON Value where
toJSON :: Value -> Value
toJSON (String Text
x) = Text -> Value
JSON.String Text
x
toJSON (Binary ByteString
x) = Text -> Value
JSON.String forall a b. (a -> b) -> a -> b
$ Text
"base64:" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeBase64 ByteString
x
toJSON (Number Scientific
x) = Scientific -> Value
JSON.Number Scientific
x
toJSON (Bool Bool
x) = Bool -> Value
JSON.Bool Bool
x
toJSON (List [Value]
xs) = Array -> Value
JSON.Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
Vector.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Value]
xs
toEncoding :: Value -> Encoding
toEncoding (String Text
x) = forall a. Text -> Encoding' a
text Text
x
toEncoding (Binary ByteString
x) = forall a. Text -> Encoding' a
text forall a b. (a -> b) -> a -> b
$ Text
"base64:" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeBase64 ByteString
x
toEncoding (Number Scientific
x) = Scientific -> Encoding
scientific Scientific
x
toEncoding (Bool Bool
x) = Bool -> Encoding
bool Bool
x
toEncoding (List [Value]
xs) = forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. ToJSON a => a -> Encoding
toEncoding [Value]
xs
class FromValue a where
fromValue :: Value -> Maybe a
class ToValue a where
toValue :: a -> Value
instance FromValue Value where
fromValue :: Value -> Maybe Value
fromValue = forall a. a -> Maybe a
Just
instance ToValue Value where
toValue :: Value -> Value
toValue = forall a. a -> a
id
instance FromValue Text where
fromValue :: Value -> Maybe Text
fromValue (String Text
x) = forall a. a -> Maybe a
Just Text
x
fromValue (Binary ByteString
x) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
x
fromValue (Number Scientific
x) =
forall a. a -> Maybe a
Just
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> FilePath
formatScientific FPFormat
Fixed (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ if Scientific -> Bool
isInteger Scientific
x then Int
0 else Int
2)
forall a b. (a -> b) -> a -> b
$ Scientific
x
fromValue (Bool Bool
x) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ Bool
x
fromValue (List [Value]
xs) = Text -> [Text] -> Text
intercalate Text
", " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromValue a => Value -> Maybe a
fromValue [Value]
xs
instance ToValue Text where
toValue :: Text -> Value
toValue = Text -> Value
String
instance FromValue ByteString where
fromValue :: Value -> Maybe ByteString
fromValue (Binary ByteString
x) = forall a. a -> Maybe a
Just ByteString
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue ByteString where
toValue :: ByteString -> Value
toValue = ByteString -> Value
Binary
instance FromValue Int where
fromValue :: Value -> Maybe Int
fromValue (Number Scientific
x) = forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Int where
toValue :: Int -> Value
toValue = Scientific -> Value
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance FromValue Integer where
fromValue :: Value -> Maybe Integer
fromValue Value
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromValue a => Value -> Maybe a
fromValue Value
x :: Maybe Int)
instance ToValue Integer where
toValue :: Integer -> Value
toValue = Scientific -> Value
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance FromValue Float where
fromValue :: Value -> Maybe Float
fromValue (Number Scientific
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Float where
toValue :: Float -> Value
toValue = Scientific -> Value
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => a -> Scientific
fromFloatDigits
instance FromValue Double where
fromValue :: Value -> Maybe Double
fromValue (Number Scientific
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Double where
toValue :: Double -> Value
toValue = Scientific -> Value
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => a -> Scientific
fromFloatDigits
instance FromValue Bool where
fromValue :: Value -> Maybe Bool
fromValue (Bool Bool
x) = forall a. a -> Maybe a
Just Bool
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Bool where
toValue :: Bool -> Value
toValue = Bool -> Value
Bool
instance FromValue a => FromValue [a] where
fromValue :: Value -> Maybe [a]
fromValue (List [Value]
xs) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromValue a => Value -> Maybe a
fromValue [Value]
xs
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue a => ToValue [a] where
toValue :: [a] -> Value
toValue = [Value] -> Value
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToValue a => a -> Value
toValue
startExifTool :: IO ExifTool
startExifTool :: IO ExifTool
startExifTool = do
(Just Handle
i, Just Handle
o, Just Handle
e, ProcessHandle
p) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
conf
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Handle -> Handle -> Handle -> ProcessHandle -> ExifTool
ET Handle
i Handle
o Handle
e ProcessHandle
p
where
conf :: CreateProcess
conf =
(FilePath -> [FilePath] -> CreateProcess
proc FilePath
"exiftool" [FilePath]
options)
{ std_in :: StdStream
std_in = StdStream
CreatePipe,
std_out :: StdStream
std_out = StdStream
CreatePipe,
std_err :: StdStream
std_err = StdStream
CreatePipe
}
options :: [FilePath]
options = [FilePath
"-stay_open", FilePath
"True", FilePath
"-@", FilePath
"-"]
stopExifTool :: ExifTool -> IO ()
stopExifTool :: ExifTool -> IO ()
stopExifTool (ET Handle
i Handle
o Handle
e ProcessHandle
p) = do
Handle -> Text -> IO ()
hPutStrLn Handle
i Text
"-stay_open"
Handle -> Text -> IO ()
hPutStrLn Handle
i Text
"False"
Handle -> IO ()
hFlush Handle
i
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess (forall a. a -> Maybe a
Just Handle
i, forall a. a -> Maybe a
Just Handle
o, forall a. a -> Maybe a
Just Handle
e, ProcessHandle
p)
withExifTool :: (ExifTool -> IO a) -> IO a
withExifTool :: forall a. (ExifTool -> IO a) -> IO a
withExifTool = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ExifTool
startExifTool ExifTool -> IO ()
stopExifTool
sendCommand :: ExifTool -> [Text] -> IO (Either Text Text)
sendCommand :: ExifTool -> [Text] -> IO (Either Text Text)
sendCommand (ET Handle
i Handle
o Handle
e ProcessHandle
_) [Text]
cmds = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Text -> IO ()
hPutStrLn Handle
i) [Text]
cmds
Handle -> Text -> IO ()
hPutStrLn Handle
i Text
"-execute"
Handle -> IO ()
hFlush Handle
i
Text
out <- Handle -> Text -> IO Text
readOut Handle
o Text
""
Text
err <- Handle -> Text -> IO Text
readErr Handle
e Text
""
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Text -> Bool
isError Text
err
then forall a b. a -> Either a b
Left Text
err
else forall a b. b -> Either a b
Right Text
out
where
readOut :: Handle -> Text -> IO Text
readOut :: Handle -> Text -> IO Text
readOut Handle
h Text
acc = do
Text
l <- Handle -> IO Text
hGetLine Handle
h
if Text
"{ready}" Text -> Text -> Bool
`isPrefixOf` Text
l
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
acc
else Handle -> Text -> IO Text
readOut Handle
h (Text
acc forall a. Semigroup a => a -> a -> a
<> Text
l)
readErr :: Handle -> Text -> IO Text
readErr :: Handle -> Text -> IO Text
readErr Handle
h Text
acc = do
Bool
hasMore <- Handle -> IO Bool
hReady Handle
h
if Bool -> Bool
not Bool
hasMore
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
acc
else do
Text
l <- Handle -> IO Text
hGetLine Handle
h
Handle -> Text -> IO Text
readErr Handle
h (Text
acc forall a. Semigroup a => a -> a -> a
<> Text
l)
isError :: Text -> Bool
isError :: Text -> Bool
isError Text
t = Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"", Text
" 1 image files updated"]
readMeta :: ExifTool -> [Tag] -> FilePath -> IO Metadata
readMeta :: ExifTool -> [Tag] -> FilePath -> IO Metadata
readMeta ExifTool
et [Tag]
ts FilePath
fp = forall a. Either Text a -> a
eitherError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExifTool -> [Tag] -> FilePath -> IO (Either Text Metadata)
readMetaEither ExifTool
et [Tag]
ts FilePath
fp
readMetaEither :: ExifTool -> [Tag] -> FilePath -> IO (Either Text Metadata)
readMetaEither :: ExifTool -> [Tag] -> FilePath -> IO (Either Text Metadata)
readMetaEither ExifTool
et [Tag]
ts FilePath
fp = do
Either Text Text
result <- ExifTool -> [Text] -> IO (Either Text Text)
sendCommand ExifTool
et (forall target source. From source target => source -> target
into @Text FilePath
fp forall a. a -> [a] -> [a]
: [Text]
options forall a. Semigroup a => a -> a -> a
<> [Text]
tags)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HashMap Tag Value -> Metadata
Metadata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys Tag -> Tag
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Text Text
result forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either Text (HashMap Tag Value)
parseOutput)
where
options :: [Text]
options = [Text
"-json", Text
"-binary", Text
"-unknown2"]
tags :: [Text]
tags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
"-" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text
tagName) [Tag]
ts
parseOutput :: Text -> Either Text (HashMap Tag Value)
parseOutput =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall target source. From source target => source -> target
into @Text) forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @BL.ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
writeMeta :: ExifTool -> Metadata -> FilePath -> IO ()
writeMeta :: ExifTool -> Metadata -> FilePath -> IO ()
writeMeta ExifTool
et Metadata
m FilePath
fp = forall a. Either Text a -> a
eitherError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExifTool -> Metadata -> FilePath -> IO (Either Text ())
writeMetaEither ExifTool
et Metadata
m FilePath
fp
writeMetaEither :: ExifTool -> Metadata -> FilePath -> IO (Either Text ())
writeMetaEither :: ExifTool -> Metadata -> FilePath -> IO (Either Text ())
writeMetaEither ExifTool
et (Metadata HashMap Tag Value
m) FilePath
fp =
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"exiftool.json" forall a b. (a -> b) -> a -> b
$ \FilePath
metafile Handle
h -> do
Handle -> ByteString -> IO ()
BL.hPut Handle
h forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode [forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
delete (Text -> Tag
Tag Text
"SourceFile") HashMap Tag Value
m]
Handle -> IO ()
hFlush Handle
h
forall (f :: * -> *) a. Functor f => f a -> f ()
void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExifTool -> [Text] -> IO (Either Text Text)
sendCommand
ExifTool
et
(forall target source. From source target => source -> target
into @Text FilePath
fp forall a. a -> [a] -> [a]
: Text
"-json=" forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text FilePath
metafile forall a. a -> [a] -> [a]
: [Text]
options)
where
options :: [Text]
options = [Text
"-overwrite_original", Text
"-f"]
get :: FromValue a => Tag -> Metadata -> Maybe a
get :: forall a. FromValue a => Tag -> Metadata -> Maybe a
get Tag
t (Metadata HashMap Tag Value
m) = do
Value
v <- HashMap Tag Value
m forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
!? Tag -> Tag
toLower Tag
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Value
v forall a. Eq a => a -> a -> Bool
/= Text -> Value
String Text
"-")
forall a. FromValue a => Value -> Maybe a
fromValue Value
v
set :: ToValue a => Tag -> a -> Metadata -> Metadata
set :: forall a. ToValue a => Tag -> a -> Metadata -> Metadata
set Tag
t a
v (Metadata HashMap Tag Value
m) = HashMap Tag Value -> Metadata
Metadata forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert (Tag -> Tag
toLower Tag
t) (forall a. ToValue a => a -> Value
toValue a
v) HashMap Tag Value
m
del :: Tag -> Metadata -> Metadata
del :: Tag -> Metadata -> Metadata
del Tag
t = forall a. ToValue a => Tag -> a -> Metadata -> Metadata
set Tag
t (Text -> Value
String Text
"-")
eitherError :: Either Text a -> a
eitherError :: forall a. Either Text a -> a
eitherError = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => FilePath -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @String) forall a. a -> a
id