exiftool 0.1.1.0 → 0.2.0.0

raw patch · 4 files changed

+229/−226 lines, 4 filesdep ~aesondep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, hashable

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +13/−13
• exiftool.cabal +1/−1
• src/ExifTool.hs +207/−212

@@ -1,5 +1,13 @@ # Revision history for exiftool +## 0.2.0.0 -- 2021-09-28++* New (backwards-incompatible) API. Highlights:+  * The simplified Tag type allows greater syntactic flexibility when specifying+    tag names.+  * The new FromValue/ToValue type classes and new functions for querying and+    manipulating metadata (get/set/del) support polymorphic values.+ ## 0.1.1.0 -- 2021-04-24  * The getMeta* functions now extract unknown tags as well (exiftool -U option).

@@ -11,21 +11,21 @@ A short code example:  ```haskell-{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} -import Data.HashMap.Strict ((!?))+import Data.Text (Text) 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"+data Foo = Foo+  { description :: Text,+    resolution :: Int+  }+  deriving (Show)++main :: IO ()+main = withExifTool $ \et -> do+  m <- readMeta et [] "a.jpg"+  print $ Foo <$> get (Tag "Description") m <*> get (Tag "XResolution") m+  let m' = del (Tag "Description") . set (Tag "XResolution") (42 :: Int) $ m+  writeMeta et m' "a.jpg" ```

@@ -1,5 +1,5 @@ name:                 exiftool-version:              0.1.1.0+version:              0.2.0.0 synopsis:             Haskell bindings to ExifTool description:          Haskell bindings to the [ExifTool](https://exiftool.org)                       command-line application that enable reading, writing and

@@ -1,11 +1,10 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-}  -- | -- Module     : ExifTool--- Copyright  : (c) Martin Hoppenheit 2021+-- Copyright  : (c) Martin Hoppenheit 2020-2021 -- License    : MIT -- Maintainer : martin@hoppenheit.info --@@ -14,23 +13,23 @@ -- in various file formats. Here's a short code example, the details are -- explained below. ----- > {-# LANGUAGE OverloadedLists #-} -- > {-# LANGUAGE OverloadedStrings #-} -- > --- > import Data.HashMap.Strict ((!?))+-- > import Data.Text (Text) -- > 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"+-- > data Foo = Foo+-- >   { description :: Text,+-- >     resolution :: Int+-- >   }+-- >   deriving (Show)+-- > +-- > main :: IO ()+-- > main = withExifTool $ \et -> do+-- >   m <- readMeta et [] "a.jpg"+-- >   print $ Foo <$> get (Tag "Description") m <*> get (Tag "XResolution") m+-- >   let m' = del (Tag "Description") . set (Tag "XResolution") (42 :: Int) $ m+-- >   writeMeta et m' "a.jpg" -- -- Note that this module expects the @exiftool@ binary to be in your PATH. @@ -47,46 +46,36 @@     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.+    -- | The ExifTool instance can then be used to read or write metadata in a+    -- file with the respective functions.+    readMeta,+    readMetaEither,+    writeMeta,+    writeMetaEither,+    -- | Metadata is represented by a set of 'Tag'/'Value' pairs that can be+    -- queried and manipulated with the respective functions.     Metadata,     Tag (..),+    stripGroups,     Value (..),-    filterByTag,-    (~~),+    FromValue (..),+    ToValue (..),+    get,+    set,+    del,   ) where  import Control.Exception (bracket)-import Control.Monad (void)+import Control.Monad (guard, void) 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,   )@@ -95,12 +84,27 @@ 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.HashMap.Strict (HashMap, delete, insert, mapKeys, (!?)) import Data.Hashable (Hashable)-import Data.Scientific (Scientific)+import Data.Scientific+  ( FPFormat (Fixed),+    Scientific,+    formatScientific,+    fromFloatDigits,+    isInteger,+    toBoundedInteger,+    toRealFloat,+  ) import Data.String.Conversions (cs)-import Data.Text (Text)-import qualified Data.Text as T+import Data.Text+  ( Text,+    intercalate,+    isPrefixOf,+    splitOn,+    stripPrefix,+    toCaseFold,+  )+import Data.Text.Encoding (decodeUtf8') import Data.Text.IO (hGetLine, hPutStrLn) import qualified Data.Vector as Vector import System.IO.Temp (withSystemTempFile)@@ -128,64 +132,29 @@       -- process handle of this ExifTool process       !ProcessHandle --- | 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-  { -- | 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--instance FromJSONKey Tag where-  fromJSONKey = FromJSONKeyTextParser $ parseJSON . JSON.String--instance ToJSON Tag where-  toJSON = JSON.String . showTag-  toEncoding = text . showTag+-- | A set of ExifTool tag/value pairs. Use 'get', 'set' and 'del' to query and+-- manipulate this set.+newtype Metadata = Metadata (HashMap Tag Value)+  deriving (Show, Eq)+  deriving (Semigroup, Monoid) via (HashMap Tag Value) -instance ToJSONKey Tag where-  toJSONKey = ToJSONKeyText showTag (text . showTag)+-- | An ExifTool tag name like @Tag "Description"@ or @Tag+-- "EXIF:IFD0:XResolution"@.+newtype Tag = Tag {tagName :: Text}+  deriving (Show, Eq)+  deriving (Hashable, FromJSON, FromJSONKey, ToJSON, ToJSONKey) via Text --- | 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+-- | Remove group prefixes from a tag name e.g., @stripGroups (Tag+-- "XMP:XMP-dc:Description") == Tag "Description"@.+stripGroups :: Tag -> Tag+stripGroups = Tag . last . splitOn ":" . tagName --- | 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]+-- | Make a tag name lower case.+toLower :: Tag -> Tag+toLower = Tag . toCaseFold . tagName --- | An ExifTool tag value, enclosed in a type wrapper.+-- | An ExifTool tag value, enclosed in a type wrapper. The type wrapper can+-- usually be ignored when using the 'FromValue' and 'ToValue' instances. data Value   = String !Text   | Binary !ByteString@@ -197,14 +166,13 @@  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 ""+    | Just b <- stripPrefix "base64:" x =+      either (fail . cs) (pure . Binary) (decodeBase64 $ cs b)+    | otherwise = pure $ String x+  parseJSON (JSON.Number x) = pure $ Number x+  parseJSON (JSON.Bool x) = pure $ Bool x+  parseJSON (JSON.Array xs) = List . Vector.toList <$> traverse parseJSON xs+  parseJSON JSON.Null = pure $ String ""   -- parseJSON (JSON.Object x) = Struct <$> sequence (fmap parseJSON x)   parseJSON x = fail $ "error parsing ExifTool JSON output: " <> show x @@ -220,12 +188,89 @@   toEncoding (Bool x) = bool x   toEncoding (List xs) = list toEncoding xs +-- | Data types that a 'Value' can be turned into.+--+-- @since 0.2.0.0+class FromValue a where+  fromValue :: Value -> Maybe a++-- | Data types that can be turned into a 'Value'.+--+-- @since 0.2.0.0+class ToValue a where+  toValue :: a -> Value++instance FromValue Value where+  fromValue = Just++instance ToValue Value where+  toValue = id++instance FromValue Text where+  fromValue (String x) = Just x+  fromValue (Binary x) = either (const Nothing) Just $ decodeUtf8' x+  fromValue (Number x) =+    Just . cs . formatScientific Fixed (Just $ if isInteger x then 0 else 2) $ x+  fromValue (Bool x) = Just . cs . show $ x+  fromValue (List xs) = intercalate ", " <$> traverse fromValue xs++instance ToValue Text where+  toValue = String++instance FromValue ByteString where+  fromValue (Binary x) = Just x+  fromValue _ = Nothing++instance ToValue ByteString where+  toValue = Binary++instance FromValue Int where+  fromValue (Number x) = toBoundedInteger x+  fromValue _ = Nothing++instance ToValue Int where+  toValue = Number . fromIntegral++instance FromValue Integer where+  fromValue x = fromIntegral <$> (fromValue x :: Maybe Int)++instance ToValue Integer where+  toValue = Number . fromIntegral++instance FromValue Float where+  fromValue (Number x) = Just $ toRealFloat x+  fromValue _ = Nothing++instance ToValue Float where+  toValue = Number . fromFloatDigits++instance FromValue Double where+  fromValue (Number x) = Just $ toRealFloat x+  fromValue _ = Nothing++instance ToValue Double where+  toValue = Number . fromFloatDigits++instance FromValue Bool where+  fromValue (Bool x) = Just x+  fromValue _ = Nothing++instance ToValue Bool where+  toValue = Bool++instance FromValue a => FromValue [a] where+  fromValue (List xs) = traverse fromValue xs+  fromValue _ = Nothing++instance ToValue a => ToValue [a] where+  toValue = List . fmap toValue+ -- | 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+  pure $ ET i o e p   where     conf =       (proc "exiftool" options)@@ -259,7 +304,7 @@   -- Do not switch the order of readOut/readErr lest we miss errors!   out <- readOut o ""   err <- readErr e ""-  return $+  pure $     if isError err       then Left err       else Right out@@ -267,133 +312,83 @@     readOut :: Handle -> Text -> IO Text     readOut h acc = do       l <- hGetLine h-      if "{ready}" `T.isPrefixOf` l-        then return acc+      if "{ready}" `isPrefixOf` l+        then pure acc         else readOut h (acc <> l)     readErr :: Handle -> Text -> IO Text     readErr h acc = do       hasMore <- hReady h       if not hasMore-        then return acc+        then pure 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 instance-  ExifTool ->-  -- | file name-  Text ->-  -- | tag/value Map-  IO Metadata-getMeta et file = eitherError <$> getMetaEither et file+-- | Read the given tags from a file. Use an empty tag list to return all+-- metadata. Tag names are returned in "simple" form without any leading group+-- prefixes, independent of how they are specified in the given tag list.+--+-- @since 0.2.0.0+readMeta :: ExifTool -> [Tag] -> FilePath -> IO Metadata+readMeta et ts fp = eitherError <$> readMetaEither et ts fp --- | Read all metadata from a file, with ExifTool errors returned as Left--- values.-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+-- | Like 'readMeta', but ExifTool errors are returned as Left values instead of+-- leading to runtime errors.+--+-- @since 0.2.0.0+readMetaEither :: ExifTool -> [Tag] -> FilePath -> IO (Either Text Metadata)+readMetaEither et ts fp = do+  result <- sendCommand et (cs fp : options <> tags)+  pure $ Metadata . mapKeys toLower <$> (result >>= parseOutput)   where-    parseOutput :: Text -> Either Text Metadata+    options = ["-json", "-binary", "-unknown2"]+    tags = fmap (("-" <>) . tagName) ts     parseOutput = bimap cs head . eitherDecode . cs-    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 instance-  ExifTool ->-  -- | tag/value Map-  Metadata ->-  -- | file name-  Text ->-  IO ()-setMeta et m file = eitherError <$> setMetaEither et m file+-- | Write metadata to a file. The file is modified in place, make sure you have+-- the necessary backups!+--+-- @since 0.2.0.0+writeMeta :: ExifTool -> Metadata -> FilePath -> IO ()+writeMeta et m fp = eitherError <$> writeMetaEither et m fp --- | 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 instance-  ExifTool ->-  -- | tag/value Map-  Metadata ->-  -- | file name-  Text ->-  IO (Either Text ())-setMetaEither et m file =+-- | Like 'writeMeta', but ExifTool errors are returned as Left values instead+-- of leading to runtime errors.+--+-- @since 0.2.0.0+writeMetaEither :: ExifTool -> Metadata -> FilePath -> IO (Either Text ())+writeMetaEither et (Metadata m) fp =   withSystemTempFile "exiftool.json" $ \metafile h -> do-    hPut h $ encode [delete (Tag "" "" "SourceFile") m]+    hPut h $ encode [delete (Tag "SourceFile") m]     hFlush h-    void <$> sendCommand et (file : "-json=" <> cs metafile : options)+    void <$> sendCommand et (cs fp : "-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 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 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-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:+-- | Retrieve the value of a tag. Tag case is ignored i.e., @get (Tag+-- "Description)" m == get (Tag "description") m@. ----- * @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+-- @since 0.2.0.0+get :: FromValue a => Tag -> Metadata -> Maybe a+get t (Metadata m) = do+  v <- m !? toLower t+  guard (v /= String "-") -- Marked for deletion, see del function below.+  fromValue v++-- | Set a tag to a (new) value. Tag case is ignored. ----- Note that @~~@ has higher precedence than '<>', so @m ~~ t <> m ~~ t' == (m--- ~~ t) <> (m ~~ t')@ which makes combining filters easy.+-- @since 0.2.0.0+set :: ToValue a => Tag -> a -> Metadata -> Metadata+set t v (Metadata m) = Metadata $ insert (toLower t) (toValue v) m++-- | Delete a tag (i.e., set its value to a marker that will make ExifTool+-- delete it when 'writeMeta' is called). Tag case is ignored. ----- Hint: This operator is useful to find exact tag names in ghci.-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' :: Text -> Text -> Bool-    match' "" _ = True -- But not in reverse!-    match' x x' = T.toCaseFold x == T.toCaseFold x'+-- @since 0.2.0.0+del :: Tag -> Metadata -> Metadata+del t = set t (String "-")  -- | Extract content from Right or throw error. eitherError :: Either Text a -> a