diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for exiftool +## 0.1.1.0 -- 2021-04-24 + +* The getMeta* functions now extract unknown tags as well (exiftool -U option). +* Improved documentation in [README](README.md). +* Dependency version bumps. + ## 0.1.0.0 -- 2020-09-14 * Initial release. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2020 Martin Hoppenheit +Copyright (c) 2020-2021 Martin Hoppenheit Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,31 @@ # exiftool-haskell +[![Hackage](https://img.shields.io/hackage/v/exiftool)](https://hackage.haskell.org/package/exiftool) +[![CI](https://github.com/marhop/exiftool-haskell/actions/workflows/ci.yml/badge.svg)](https://github.com/marhop/exiftool-haskell/actions/workflows/ci.yml) + Haskell bindings to the [ExifTool](https://exiftool.org) command-line application that enable reading, writing and deleting metadata in various file formats. + +Full documentation is on [Hackage](https://hackage.haskell.org/package/exiftool/docs/ExifTool.html). +A short code example: + +```haskell +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +import Data.HashMap.Strict ((!?)) +import ExifTool + +example :: IO () +example = + withExifTool $ \et -> do + -- Read metadata, with exact (!?) and fuzzy (~~) tag lookup. + m <- getMeta et "a.jpg" + print $ m !? Tag "EXIF" "ExifIFD" "DateTimeOriginal" + print $ m ~~ Tag "EXIF" "" "XResolution" + print $ m ~~ Tag "XMP" "" "" + -- Write and delete metadata. + setMeta et [(Tag "XMP" "XMP-dc" "Description", String "...")] "a.jpg" + deleteMeta et [Tag "XMP" "XMP-dc" "Description"] "a.jpg" +``` diff --git a/exiftool.cabal b/exiftool.cabal --- a/exiftool.cabal +++ b/exiftool.cabal @@ -1,5 +1,5 @@ name: exiftool -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Haskell bindings to ExifTool description: Haskell bindings to the [ExifTool](https://exiftool.org) command-line application that enable reading, writing and @@ -9,7 +9,7 @@ license-file: LICENSE author: Martin Hoppenheit maintainer: martin@hoppenheit.info -copyright: 2020 Martin Hoppenheit +copyright: 2020-2021 Martin Hoppenheit category: Foreign build-type: Simple extra-source-files: README.md @@ -21,16 +21,16 @@ exposed-modules: ExifTool default-language: Haskell2010 ghc-options: -Wall - build-depends: base >= 4.13 && < 5 + build-depends: base >= 4.12 && < 5 , aeson >= 1.5.4 && < 1.6 , base64 >= 0.4.2 && < 0.5 - , bytestring >= 0.10.10 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , hashable >= 1.3.0 && < 1.4 - , process >= 1.6.9 && < 1.7 + , process >= 1.6.5 && < 1.7 , scientific >= 0.3.6 && < 0.4 , string-conversions >= 0.4.0 && < 0.5 , temporary >= 1.3 && < 1.4 - , text >= 1.2.4 && < 1.3 + , text >= 1.2.3 && < 1.3 , unordered-containers >= 0.2.12 && < 0.3 , vector >= 0.12.1 && < 0.13 diff --git a/src/ExifTool.hs b/src/ExifTool.hs --- a/src/ExifTool.hs +++ b/src/ExifTool.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -- | -- Module : ExifTool --- Copyright : (c) Martin Hoppenheit 2020 +-- Copyright : (c) Martin Hoppenheit 2021 -- License : MIT -- Maintainer : martin@hoppenheit.info -- @@ -14,80 +14,84 @@ -- in various file formats. Here's a short code example, the details are -- explained below. -- --- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE OverloadedLists #-} --- > --- > import ExifTool +-- > {-# LANGUAGE OverloadedStrings #-} +-- > -- > import Data.HashMap.Strict ((!?)) --- > +-- > import ExifTool +-- > -- > example :: IO () -- > example = --- > withExifTool $ \et -> do --- > -- Read metadata, with exact (!?) and fuzzy (~~) tag lookup. --- > m <- getMeta et "a.jpg" --- > print $ m !? Tag "EXIF" "ExifIFD" "DateTimeOriginal" --- > print $ m ~~ Tag "EXIF" "" "XResolution" --- > print $ m ~~ Tag "XMP" "" "" --- > -- Write and delete metadata. --- > setMeta et [(Tag "XMP" "XMP-dc" "Description", String "...")] "a.jpg" --- > deleteMeta et [Tag "XMP" "XMP-dc" "Description"] "a.jpg" +-- > withExifTool $ \et -> do +-- > -- Read metadata, with exact (!?) and fuzzy (~~) tag lookup. +-- > m <- getMeta et "a.jpg" +-- > print $ m !? Tag "EXIF" "ExifIFD" "DateTimeOriginal" +-- > print $ m ~~ Tag "EXIF" "" "XResolution" +-- > print $ m ~~ Tag "XMP" "" "" +-- > -- Write and delete metadata. +-- > setMeta et [(Tag "XMP" "XMP-dc" "Description", String "...")] "a.jpg" +-- > deleteMeta et [Tag "XMP" "XMP-dc" "Description"] "a.jpg" -- -- Note that this module expects the @exiftool@ binary to be in your PATH. module ExifTool - ( -- * Running an ExifTool instance - -- - -- | Most functions in this module interact with an ExifTool instance - -- i.e., a running ExifTool process represented by the 'ExifTool' data - -- type. The easiest way to obtain an instance is the 'withExifTool' - -- function that takes care of starting and stopping the process. - ExifTool - , startExifTool - , stopExifTool - , withExifTool - -- * Reading and writing metadata - -- - -- | The ExifTool instance can then be used to read, write or delete - -- metadata in a file with the respective functions. These come in two - -- variants, one that throws runtime errors when the ExifTool process - -- returns error messages and one that instead produces Either values. - -- Choose those that best fit your use case. - , getMeta - , setMeta - , deleteMeta - , getMetaEither - , setMetaEither - , deleteMetaEither - -- * Data types and utility functions - -- - -- | Metadata is represented by a 'Data.HashMap.Strict.HashMap' of - -- 'Tag'/'Value' pairs (with alias 'Metadata'), so it is advisable to - -- import some functions like 'Data.HashMap.Strict.lookup' or - -- 'Data.HashMap.Strict.!?' from the "Data.HashMap.Strict" module. The - -- ExifTool module defines additional utility functions that make working - -- with Metadata easier. - , Metadata - , Tag(..) - , Value(..) - , filterByTag - , (~~) - ) where + ( -- * Running an ExifTool instance + -- + -- | Most functions in this module interact with an ExifTool instance + -- i.e., a running ExifTool process represented by the 'ExifTool' data + -- type. The easiest way to obtain an instance is the 'withExifTool' + -- function that takes care of starting and stopping the process. + ExifTool, + startExifTool, + stopExifTool, + withExifTool, + -- * Reading and writing metadata + -- + -- | The ExifTool instance can then be used to read, write or delete + -- metadata in a file with the respective functions. These come in two + -- variants, one that throws runtime errors when the ExifTool process + -- returns error messages and one that instead produces Either values. + -- Choose those that best fit your use case. + getMeta, + setMeta, + deleteMeta, + getMetaEither, + setMetaEither, + deleteMetaEither, + -- * Data types and utility functions + -- + -- | Metadata is represented by a 'Data.HashMap.Strict.HashMap' of + -- 'Tag'/'Value' pairs (with alias 'Metadata'), so it is advisable to + -- import some functions like 'Data.HashMap.Strict.lookup' or + -- 'Data.HashMap.Strict.!?' from the "Data.HashMap.Strict" module. The + -- ExifTool module defines additional utility functions that make working + -- with Metadata easier. + Metadata, + Tag (..), + Value (..), + filterByTag, + (~~), + ) +where import Control.Exception (bracket) import Control.Monad (void) -import qualified Data.Aeson as JSON +import Data.Bifunctor (bimap) +import GHC.Generics (Generic) +import System.IO (Handle, hFlush, hReady) + import Data.Aeson - ( FromJSON(..) - , FromJSONKey(..) - , FromJSONKeyFunction(..) - , ToJSON(..) - , ToJSONKey(..) - , ToJSONKeyFunction(..) - , eitherDecode - , encode - ) + ( FromJSON (..), + FromJSONKey (..), + FromJSONKeyFunction (..), + ToJSON (..), + ToJSONKey (..), + ToJSONKeyFunction (..), + 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 Data.ByteString.Lazy (hPut) @@ -99,27 +103,30 @@ import qualified Data.Text as T import Data.Text.IO (hGetLine, hPutStrLn) import qualified Data.Vector as Vector -import GHC.Generics (Generic) -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 - ) + ( ProcessHandle, + StdStream (CreatePipe), + cleanupProcess, + createProcess, + proc, + std_err, + std_in, + std_out, + ) -- | An ExifTool instance, initialized with 'startExifTool' and terminated with -- 'stopExifTool'. -data ExifTool = ET - !Handle -- ^ STDIN of this ExifTool process - !Handle -- ^ STDOUT of this ExifTool process - !Handle -- ^ STDERR of this ExifTool process - !ProcessHandle -- ^ process handle of this ExifTool process +data ExifTool + = ET + -- STDIN of this ExifTool process + !Handle + -- STDOUT of this ExifTool process + !Handle + -- STDERR of this ExifTool process + !Handle + -- process handle of this ExifTool process + !ProcessHandle -- | A set of ExifTool tag/value pairs. type Metadata = HashMap Tag Value @@ -139,35 +146,39 @@ -- * Run something like @exiftool -s -a -G:0:1@. -- * Use the '~~' operator in ghci. data Tag = Tag - { tagFamily0 :: !Text -- ^ family 0 tag group - , tagFamily1 :: !Text -- ^ family 1 tag group - , tagName :: !Text -- ^ actual tag name - } deriving (Show, Eq, Generic, Hashable) + { -- | family 0 tag group + tagFamily0 :: !Text, + -- | family 1 tag group + tagFamily1 :: !Text, + -- | actual tag name + tagName :: !Text + } + deriving (Show, Eq, Generic, Hashable) instance FromJSON Tag where - parseJSON (JSON.String x) - | Just t <- readTag x = return t - parseJSON x = fail $ "unexpected formatting of ExifTool tag: " <> show x + parseJSON (JSON.String x) + | Just t <- readTag x = return t + parseJSON x = fail $ "unexpected formatting of ExifTool tag: " <> show x instance FromJSONKey Tag where - fromJSONKey = FromJSONKeyTextParser $ parseJSON . JSON.String + fromJSONKey = FromJSONKeyTextParser $ parseJSON . JSON.String instance ToJSON Tag where - toJSON = JSON.String . showTag - toEncoding = text . showTag + toJSON = JSON.String . showTag + toEncoding = text . showTag instance ToJSONKey Tag where - toJSONKey = ToJSONKeyText showTag (text . showTag) + toJSONKey = ToJSONKeyText showTag (text . showTag) -- | Parse an ExifTool tag name of the form @family0:family1:name@, -- @family0:name@ or @name@ (but /not/ @family1:name@). readTag :: Text -> Maybe Tag readTag t = - case T.splitOn ":" t of - [f0, f1, n] -> Just $ Tag f0 f1 n - [f0, n] -> Just $ Tag f0 "" n - [n] -> Just $ Tag "" "" n - _ -> Nothing + case T.splitOn ":" t of + [f0, f1, n] -> Just $ Tag f0 f1 n + [f0, n] -> Just $ Tag f0 "" n + [n] -> Just $ Tag "" "" n + _ -> Nothing -- | Format an ExifTool tag name in the form @family0:family1:name@, -- @family0:name@, @family1:name@ or @name@. @@ -176,58 +187,61 @@ -- | An ExifTool tag value, enclosed in a type wrapper. data Value - = String !Text - | Binary !ByteString - | Number !Scientific - | Bool !Bool - | List ![Value] - -- Struct (Map Text Value) - deriving (Show, Eq) + = String !Text + | Binary !ByteString + | Number !Scientific + | Bool !Bool + | List ![Value] + -- Struct (Map Text Value) + deriving (Show, Eq) instance FromJSON Value where - parseJSON (JSON.String x) - | Just b <- T.stripPrefix "base64:" x = - either (fail . cs) (return . Binary) (decodeBase64 $ cs b) - | otherwise = return $ String x - parseJSON (JSON.Number x) = return $ Number x - parseJSON (JSON.Bool x) = return $ Bool x - parseJSON (JSON.Array xs) = - List <$> sequence (Vector.toList $ fmap parseJSON xs) - parseJSON JSON.Null = return $ String "" - -- parseJSON (JSON.Object x) = Struct <$> sequence (fmap parseJSON x) - parseJSON x = fail $ "error parsing ExifTool JSON output: " <> show x + parseJSON (JSON.String x) + | Just b <- T.stripPrefix "base64:" x = + either (fail . cs) (return . Binary) (decodeBase64 $ cs b) + | otherwise = return $ String x + parseJSON (JSON.Number x) = return $ Number x + parseJSON (JSON.Bool x) = return $ Bool x + parseJSON (JSON.Array xs) = + List <$> sequence (Vector.toList $ fmap parseJSON xs) + parseJSON JSON.Null = return $ String "" + -- parseJSON (JSON.Object x) = Struct <$> sequence (fmap parseJSON x) + parseJSON x = fail $ "error parsing ExifTool JSON output: " <> show x instance ToJSON Value where - toJSON (String x) = JSON.String x - toJSON (Binary x) = JSON.String $ "base64:" <> encodeBase64 x - toJSON (Number x) = JSON.Number x - toJSON (Bool x) = JSON.Bool x - toJSON (List xs) = JSON.Array . Vector.fromList $ map toJSON xs - toEncoding (String x) = text x - toEncoding (Binary x) = text $ "base64:" <> encodeBase64 x - toEncoding (Number x) = scientific x - toEncoding (Bool x) = bool x - toEncoding (List xs) = list toEncoding xs + toJSON (String x) = JSON.String x + toJSON (Binary x) = JSON.String $ "base64:" <> encodeBase64 x + toJSON (Number x) = JSON.Number x + toJSON (Bool x) = JSON.Bool x + toJSON (List xs) = JSON.Array . Vector.fromList $ map toJSON xs + toEncoding (String x) = text x + toEncoding (Binary x) = text $ "base64:" <> encodeBase64 x + toEncoding (Number x) = scientific x + toEncoding (Bool x) = bool x + toEncoding (List xs) = list toEncoding xs -- | Start an ExifTool instance. Use 'stopExifTool' when done, or 'withExifTool' -- to combine both steps. startExifTool :: IO ExifTool startExifTool = do - (Just i, Just o, Just e, p) <- createProcess conf - return $ ET i o e p + (Just i, Just o, Just e, p) <- createProcess conf + return $ ET i o e p where conf = - (proc "exiftool" options) - {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe} + (proc "exiftool" options) + { std_in = CreatePipe, + std_out = CreatePipe, + std_err = CreatePipe + } options = ["-stay_open", "True", "-@", "-"] -- | Stop a running ExifTool instance. stopExifTool :: ExifTool -> IO () stopExifTool (ET i o e p) = do - hPutStrLn i "-stay_open" - hPutStrLn i "False" - hFlush i - cleanupProcess (Just i, Just o, Just e, p) + hPutStrLn i "-stay_open" + hPutStrLn i "False" + hFlush i + cleanupProcess (Just i, Just o, Just e, p) -- | Start an ExifTool instance, do something with it, then stop it. withExifTool :: (ExifTool -> IO a) -> IO a @@ -239,96 +253,117 @@ -- The final @-execute@ argument is added automatically. sendCommand :: ExifTool -> [Text] -> IO (Either Text Text) sendCommand (ET i o e _) cmds = do - mapM_ (hPutStrLn i) cmds - hPutStrLn i "-execute" - hFlush i - -- Do not switch the order of readOut/readErr lest we miss errors! - out <- readOut o "" - err <- readErr e "" - return $ - if isError err - then Left err - else Right out + mapM_ (hPutStrLn i) cmds + hPutStrLn i "-execute" + hFlush i + -- Do not switch the order of readOut/readErr lest we miss errors! + out <- readOut o "" + err <- readErr e "" + return $ + if isError err + then Left err + else Right out where - -- | Read from handle up to the string @{ready}@. readOut :: Handle -> Text -> IO Text readOut h acc = do - l <- hGetLine h - if "{ready}" `T.isPrefixOf` l - then return acc - else readOut h (acc <> l) - -- | Read /currently/ available data from handle, don't wait for more. + l <- hGetLine h + if "{ready}" `T.isPrefixOf` l + then return acc + else readOut h (acc <> l) readErr :: Handle -> Text -> IO Text readErr h acc = do - hasMore <- hReady h - if not hasMore - then return acc - else do - l <- hGetLine h - readErr h (acc <> l) - -- | Make sure an error string actually counts as error. + hasMore <- hReady h + if not hasMore + then return acc + else do + l <- hGetLine h + readErr h (acc <> l) isError :: Text -> Bool isError t = t `notElem` ["", " 1 image files updated"] -- | Read all metadata from a file, with ExifTool errors leading to runtime -- errors. (Use 'getMetaEither' instead if you would rather intercept them.) -getMeta :: ExifTool -- ^ ExifTool instance - -> Text -- ^ file name - -> IO Metadata -- ^ tag/value Map +getMeta :: + -- | ExifTool instance + ExifTool -> + -- | file name + Text -> + -- | tag/value Map + IO Metadata getMeta et file = eitherError <$> getMetaEither et file -- | Read all metadata from a file, with ExifTool errors returned as Left -- values. -getMetaEither :: ExifTool -- ^ ExifTool instance - -> Text -- ^ file name - -> IO (Either Text Metadata) -- ^ tag/value Map +getMetaEither :: + -- | ExifTool instance + ExifTool -> + -- | file name + Text -> + -- | tag/value Map + IO (Either Text Metadata) getMetaEither et file = do - result <- sendCommand et (file : options) - return $ result >>= parseOutput + result <- sendCommand et (file : options) + return $ result >>= parseOutput where parseOutput :: Text -> Either Text Metadata parseOutput = bimap cs head . eitherDecode . cs - options = ["-json", "-a", "-G:0:1", "-s", "-binary"] + options = ["-json", "-a", "-U", "-G:0:1", "-s", "-binary"] -- | Write metadata to a file, with ExifTool errors leading to runtime errors. -- (Use 'setMetaEither' instead if you would rather intercept them.) The file is -- modified in place. Make sure you have the necessary backups! -setMeta :: ExifTool -- ^ ExifTool instance - -> Metadata -- ^ tag/value Map - -> Text -- ^ file name - -> IO () +setMeta :: + -- | ExifTool instance + ExifTool -> + -- | tag/value Map + Metadata -> + -- | file name + Text -> + IO () setMeta et m file = eitherError <$> setMetaEither et m file -- | Write metadata to a file, with ExifTool errors returned as Left values. The -- file is modified in place. Make sure you have the necessary backups! -setMetaEither :: ExifTool -- ^ ExifTool instance - -> Metadata -- ^ tag/value Map - -> Text -- ^ file name - -> IO (Either Text ()) +setMetaEither :: + -- | ExifTool instance + ExifTool -> + -- | tag/value Map + Metadata -> + -- | file name + Text -> + IO (Either Text ()) setMetaEither et m file = - withSystemTempFile "exiftool.json" $ \metafile h -> do - hPut h $ encode [delete (Tag "" "" "SourceFile") m] - hFlush h - void <$> sendCommand et (file : "-json=" <> cs metafile : options) + withSystemTempFile "exiftool.json" $ \metafile h -> do + hPut h $ encode [delete (Tag "" "" "SourceFile") m] + hFlush h + void <$> sendCommand et (file : "-json=" <> cs metafile : options) where options = ["-overwrite_original", "-f"] -- | Delete metadata from a file, with ExifTool errors leading to runtime -- errors. (Use 'deleteMetaEither' instead if you would rather intercept them.) -- The file is modified in place. Make sure you have the necessary backups! -deleteMeta :: ExifTool -- ^ ExifTool instance - -> [Tag] -- ^ tags to be deleted - -> Text -- ^ file name - -> IO () +deleteMeta :: + -- | ExifTool instance + ExifTool -> + -- | tags to be deleted + [Tag] -> + -- | file name + Text -> + IO () deleteMeta et ts file = eitherError <$> deleteMetaEither et ts file -- | Delete metadata from a file, with ExifTool errors returned as Left values. -- The file is modified in place. Make sure you have the necessary backups! -deleteMetaEither :: ExifTool -- ^ ExifTool instance - -> [Tag] -- ^ tags to be deleted - -> Text -- ^ file name - -> IO (Either Text ()) -deleteMetaEither et ts = setMetaEither et (fromList $ fmap (, String "-") ts) +deleteMetaEither :: + -- | ExifTool instance + ExifTool -> + -- | tags to be deleted + [Tag] -> + -- | file name + Text -> + IO (Either Text ()) +deleteMetaEither et ts = setMetaEither et (fromList $ fmap (,String "-") ts) -- | Filter metadata by tag name. filterByTag :: (Tag -> Bool) -> Metadata -> Metadata @@ -349,13 +384,13 @@ -- ~~ t) <> (m ~~ t')@ which makes combining filters easy. -- -- Hint: This operator is useful to find exact tag names in ghci. -(~~) :: Metadata -> Tag -> Metadata infixl 8 ~~ +(~~) :: Metadata -> Tag -> Metadata (~~) m t = filterByTag (match t) m where match :: Tag -> Tag -> Bool match (Tag f0 f1 n) (Tag f0' f1' n') = - match' f0 f0' && match' f1 f1' && match' n n' + match' f0 f0' && match' f1 f1' && match' n n' match' :: Text -> Text -> Bool match' "" _ = True -- But not in reverse! match' x x' = T.toCaseFold x == T.toCaseFold x'