exiftool (empty) → 0.1.0.0
raw patch · 6 files changed
+437/−0 lines, 6 filesdep +aesondep +basedep +base64setup-changed
Dependencies added: aeson, base, base64, bytestring, hashable, process, scientific, string-conversions, temporary, text, unordered-containers, vector
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +5/−0
- Setup.hs +2/−0
- exiftool.cabal +39/−0
- src/ExifTool.hs +365/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for exiftool++## 0.1.0.0 -- 2020-09-14++* Initial release.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 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+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,5 @@+# exiftool-haskell++Haskell bindings to the [ExifTool](https://exiftool.org) command-line+application that enable reading, writing and deleting metadata in various file+formats.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exiftool.cabal view
@@ -0,0 +1,39 @@+name: exiftool+version: 0.1.0.0+synopsis: Haskell bindings to ExifTool+description: Haskell bindings to the [ExifTool](https://exiftool.org)+ command-line application that enable reading, writing and+ deleting metadata in various file formats.+homepage: https://github.com/marhop/exiftool-haskell+license: MIT+license-file: LICENSE+author: Martin Hoppenheit+maintainer: martin@hoppenheit.info+copyright: 2020 Martin Hoppenheit+category: Foreign+build-type: Simple+extra-source-files: README.md+ , CHANGELOG.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: ExifTool+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends: base >= 4.13 && < 5+ , aeson >= 1.5.4 && < 1.6+ , base64 >= 0.4.2 && < 0.5+ , bytestring >= 0.10.10 && < 0.11+ , hashable >= 1.3.0 && < 1.4+ , process >= 1.6.9 && < 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+ , unordered-containers >= 0.2.12 && < 0.3+ , vector >= 0.12.1 && < 0.13++source-repository head+ type: git+ location: https://github.com/marhop/exiftool-haskell
+ src/ExifTool.hs view
@@ -0,0 +1,365 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module : ExifTool+-- Copyright : (c) Martin Hoppenheit 2020+-- License : MIT+-- Maintainer : martin@hoppenheit.info+--+-- This module contains bindings to the [ExifTool](https://exiftool.org)+-- command-line application that enable reading, writing and deleting metadata+-- in various file formats. Here's a short code example, the details are+-- explained below.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE OverloadedLists #-}+-- >+-- > import ExifTool+-- > import Data.HashMap.Strict ((!?))+-- >+-- > 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"+--+-- 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++import Control.Exception (bracket)+import Control.Monad (void)+import qualified Data.Aeson as JSON+import Data.Aeson+ ( FromJSON(..)+ , FromJSONKey(..)+ , FromJSONKeyFunction(..)+ , ToJSON(..)+ , ToJSONKey(..)+ , ToJSONKeyFunction(..)+ , eitherDecode+ , encode+ )+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)+import Data.HashMap.Strict (HashMap, delete, filterWithKey, fromList)+import Data.Hashable (Hashable)+import Data.Scientific (Scientific)+import Data.String.Conversions (cs)+import Data.Text (Text)+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+ )++-- | 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++-- | A set of ExifTool tag/value pairs.+type Metadata = HashMap Tag Value++-- | An ExifTool tag name, consisting of three components:+--+-- 1. The family 0 tag group (information type) e.g., @EXIF@ or @XMP@.+-- 2. The family 1 tag group (specific location) e.g., @IFD0@ or @XMP-dc@.+-- 3. The actual tag name e.g., @XResolution@ or @Description@.+--+-- Example: @Tag \"EXIF\" \"IFD0\" \"XResolution\"@ corresponds to the ExifTool+-- tag name @EXIF:IFD0:XResolution@.+--+-- During development, there are several ways to find the exact name of a tag:+--+-- * See <https://exiftool.org/#groups> for a list of tag groups.+-- * 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)++instance FromJSON Tag where+ 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++instance ToJSON Tag where+ toJSON = JSON.String . showTag+ toEncoding = text . showTag++instance ToJSONKey Tag where+ 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++-- | Format an ExifTool tag name in the form @family0:family1:name@,+-- @family0:name@, @family1:name@ or @name@.+showTag :: Tag -> Text+showTag (Tag f0 f1 n) = T.intercalate ":" $ filter (not . T.null) [f0, f1, n]++-- | 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)++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++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++-- | 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+ where+ conf =+ (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)++-- | Start an ExifTool instance, do something with it, then stop it.+withExifTool :: (ExifTool -> IO a) -> IO a+withExifTool = bracket startExifTool stopExifTool++-- | Send a sequence of command-line arguments to a running ExifTool instance+-- and return the corresponding output/errors.+--+-- 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+ 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.+ 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.+ 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 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 et file = do+ 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"]++-- | 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 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 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)+ 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 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)++-- | Filter metadata by tag name.+filterByTag :: (Tag -> Bool) -> Metadata -> Metadata+filterByTag p = filterWithKey (\t _ -> p t)++-- | Filter metadata by fuzzy tag name matching. Tag names are matched ignoring+-- case, and empty components of the given tag name are considered wildcards.+-- Examples:+--+-- * @m ~~ Tag \"EXIF\" \"IFD0\" \"XResolution\"@ matches exactly the given tag+-- name (ignoring case)+-- * @m ~~ Tag "exif" "" "xresolution"@ matches all EXIF tags with name+-- xresolution (ignoring case), including @EXIF:IFD0:XResolution@ and+-- @EXIF:IFD1:XResolution@+-- * @m ~~ Tag \"XMP\" "" ""@ matches all XMP tags+--+-- Note that @~~@ has higher precedence than '<>', so @m ~~ t <> m ~~ t' == (m+-- ~~ 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 ~~+(~~) 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' :: Text -> Text -> Bool+ match' "" _ = True -- But not in reverse!+ match' x x' = T.toCaseFold x == T.toCaseFold x'++-- | Extract content from Right or throw error.+eitherError :: Either Text a -> a+eitherError = either (error . cs) id