exiftool 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+261/−194 lines, 5 filesdep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- LICENSE +1/−1
- README.md +26/−0
- exiftool.cabal +6/−6
- src/ExifTool.hs +222/−187
CHANGELOG.md view
@@ -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.
LICENSE view
@@ -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
README.md view
@@ -1,5 +1,31 @@ # exiftool-haskell +[](https://hackage.haskell.org/package/exiftool)+[](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"+```
exiftool.cabal view
@@ -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
src/ExifTool.hs view
@@ -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'