{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Graphics.ExifTags where

import Data.Word
import Text.Printf (printf)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Binary.Get
import Data.Maybe (fromMaybe)

import Graphics.Types
import Graphics.PrettyPrinters
import Graphics.Helpers

exifSubIfdTag :: String -> Word16 -> (ExifValue -> Text)-> ExifTag
exifSubIfdTag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
d = TagLocation
-> Maybe String -> Word16 -> (ExifValue -> Text) -> ExifTag
ExifTag TagLocation
ExifSubIFD (String -> Maybe String
forall a. a -> Maybe a
Just String
d)

exifIfd0Tag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
d = TagLocation
-> Maybe String -> Word16 -> (ExifValue -> Text) -> ExifTag
ExifTag TagLocation
IFD0 (String -> Maybe String
forall a. a -> Maybe a
Just String
d)

exifGpsTag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
d = TagLocation
-> Maybe String -> Word16 -> (ExifValue -> Text) -> ExifTag
ExifTag TagLocation
GpsSubIFD (String -> Maybe String
forall a. a -> Maybe a
Just String
d)

withFormat :: String -> ExifValue -> Text
withFormat :: String -> ExifValue -> Text
withFormat String
fmt = String -> Text
T.pack (String -> Text) -> (ExifValue -> String) -> ExifValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
fmt (String -> String) -> (ExifValue -> String) -> ExifValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExifValue -> String
forall a. Show a => a -> String
show

asFpWithFormat :: String -> ExifValue -> Text
asFpWithFormat :: String -> ExifValue -> Text
asFpWithFormat String
fmt = String -> Text
T.pack (String -> Text) -> (ExifValue -> String) -> ExifValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
fmt (String -> String) -> (ExifValue -> String) -> ExifValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExifValue -> String
formatAsFloatingPoint Int
2

showT :: Show a => a -> Text
showT :: a -> Text
showT = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

exposureTime :: ExifTag
exposureTime            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exposureTime" Word16
0x829a ((ExifValue -> Text) -> ExifTag) -> (ExifValue -> Text) -> ExifTag
forall a b. (a -> b) -> a -> b
$ ExifValue -> Text
ppExposureTime
fnumber :: ExifTag
fnumber                 = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"fnumber" Word16
0x829d ExifValue -> Text
ppAperture
exposureProgram :: ExifTag
exposureProgram         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exposureProgram" Word16
0x8822 ExifValue -> Text
ppExposureProgram
spectralSensitivity :: ExifTag
spectralSensitivity     = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"spectralSensitivity" Word16
0x8824 ExifValue -> Text
forall a. Show a => a -> Text
showT
isoSpeedRatings :: ExifTag
isoSpeedRatings         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"isoSpeedRatings" Word16
0x8827 ExifValue -> Text
forall a. Show a => a -> Text
showT
oecf :: ExifTag
oecf                    = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"OECF" Word16
0x8828 ExifValue -> Text
forall a. Show a => a -> Text
showT
exifVersion :: ExifTag
exifVersion             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exifVersion" Word16
0x9000 ExifValue -> Text
ppExifVersion
dateTimeOriginal :: ExifTag
dateTimeOriginal        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"dateTimeOriginal" Word16
0x9003 ExifValue -> Text
forall a. Show a => a -> Text
showT
dateTimeDigitized :: ExifTag
dateTimeDigitized       = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"dateTimeDigitized" Word16
0x9004 ExifValue -> Text
forall a. Show a => a -> Text
showT
componentConfiguration :: ExifTag
componentConfiguration  = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"componentConfiguration" Word16
0x9101 ExifValue -> Text
ppComponentConfiguration
compressedBitsPerPixel :: ExifTag
compressedBitsPerPixel  = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"compressedBitsPerPixel" Word16
0x9102 (String -> Text
T.pack (String -> Text) -> (ExifValue -> String) -> ExifValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExifValue -> String
formatAsFloatingPoint Int
2)
shutterSpeedValue :: ExifTag
shutterSpeedValue       = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"shutterSpeedValue" Word16
0x9201 ((ExifValue -> Text) -> ExifTag) -> (ExifValue -> Text) -> ExifTag
forall a b. (a -> b) -> a -> b
$ ExifValue -> Text
ppExposureTime
apertureValue :: ExifTag
apertureValue           = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"apertureValue" Word16
0x9202 ExifValue -> Text
ppApexAperture
brightnessValue :: ExifTag
brightnessValue         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"brightnessValue" Word16
0x9203 ((ExifValue -> Text) -> ExifTag) -> (ExifValue -> Text) -> ExifTag
forall a b. (a -> b) -> a -> b
$ String -> ExifValue -> Text
asFpWithFormat String
"%s EV"
exposureBiasValue :: ExifTag
exposureBiasValue       = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exposureBiasValue" Word16
0x9204 ((ExifValue -> Text) -> ExifTag) -> (ExifValue -> Text) -> ExifTag
forall a b. (a -> b) -> a -> b
$ String -> ExifValue -> Text
asFpWithFormat String
"%s EV"
maxApertureValue :: ExifTag
maxApertureValue        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"maxApertureValue" Word16
0x9205 ExifValue -> Text
ppApexAperture
subjectDistance :: ExifTag
subjectDistance         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subjectDistance" Word16
0x9206 ExifValue -> Text
forall a. Show a => a -> Text
showT
meteringMode :: ExifTag
meteringMode            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"meteringMode" Word16
0x9207 ExifValue -> Text
ppMeteringMode
lightSource :: ExifTag
lightSource             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"lightSource" Word16
0x9208 ExifValue -> Text
ppLightSource
flash :: ExifTag
flash                   = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"flash" Word16
0x9209 ExifValue -> Text
ppFlash
focalLength :: ExifTag
focalLength             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"focalLength" Word16
0x920a ((ExifValue -> Text) -> ExifTag) -> (ExifValue -> Text) -> ExifTag
forall a b. (a -> b) -> a -> b
$ String -> ExifValue -> Text
asFpWithFormat String
"%s mm"
subjectArea :: ExifTag
subjectArea             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subjectArea" Word16
0x9214 ExifValue -> Text
forall a. Show a => a -> Text
showT
makerNote :: ExifTag
makerNote               = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"makerNote" Word16
0x927c ExifValue -> Text
ppUndef
userComment :: ExifTag
userComment             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"userComment" Word16
0x9286 ExifValue -> Text
ppUserComment
subSecTime :: ExifTag
subSecTime              = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subSecTime" Word16
0x9290 ExifValue -> Text
forall a. Show a => a -> Text
showT
subSecTimeOriginal :: ExifTag
subSecTimeOriginal      = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subSecTimeOriginal" Word16
0x9291 ExifValue -> Text
forall a. Show a => a -> Text
showT
subSecTimeDigitized :: ExifTag
subSecTimeDigitized     = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subSecTimeDigitized" Word16
0x9292 ExifValue -> Text
forall a. Show a => a -> Text
showT
flashPixVersion :: ExifTag
flashPixVersion         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"flashPixVersion" Word16
0xa000 ExifValue -> Text
ppFlashPixVersion
colorSpace :: ExifTag
colorSpace              = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"colorSpace" Word16
0xa001 ExifValue -> Text
ppColorSpace
exifImageWidth :: ExifTag
exifImageWidth          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exifImageWidth" Word16
0xa002 ExifValue -> Text
forall a. Show a => a -> Text
showT
exifImageHeight :: ExifTag
exifImageHeight         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exifImageHeight" Word16
0xa003 ExifValue -> Text
forall a. Show a => a -> Text
showT
relatedSoundFile :: ExifTag
relatedSoundFile        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"relatedSoundFile" Word16
0xa004 ExifValue -> Text
forall a. Show a => a -> Text
showT
flashEnergy :: ExifTag
flashEnergy             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"flashEnergy" Word16
0xa20b ExifValue -> Text
forall a. Show a => a -> Text
showT
spatialFrequencyResponse :: ExifTag
spatialFrequencyResponse= String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"spatialFrequencyResponse" Word16
0xa20c ExifValue -> Text
forall a. Show a => a -> Text
showT
focalPlaneXResolution :: ExifTag
focalPlaneXResolution   = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"focalPlaneXResolution" Word16
0xa20e ExifValue -> Text
forall a. Show a => a -> Text
showT
focalPlaneYResolution :: ExifTag
focalPlaneYResolution   = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"focalPlaneYResolution" Word16
0xa20f ExifValue -> Text
forall a. Show a => a -> Text
showT
focalPlaneResolutionUnit :: ExifTag
focalPlaneResolutionUnit= String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"focalPlaneResolutionUnit" Word16
0xa210 ExifValue -> Text
ppFocalPlaneResolutionUnit
subjectLocation :: ExifTag
subjectLocation         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subjectLocation" Word16
0xa214 ExifValue -> Text
forall a. Show a => a -> Text
showT
exposureIndex :: ExifTag
exposureIndex           = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exposureIndex" Word16
0xa215 ExifValue -> Text
forall a. Show a => a -> Text
showT
sensingMethod :: ExifTag
sensingMethod           = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"sensingMethod" Word16
0xa217 ExifValue -> Text
ppSensingMethod
fileSource :: ExifTag
fileSource              = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"fileSource" Word16
0xa300 ExifValue -> Text
ppFileSource
sceneType :: ExifTag
sceneType               = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"sceneType" Word16
0xa301 ExifValue -> Text
ppSceneType
cfaPattern :: ExifTag
cfaPattern              = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"cfaPattern" Word16
0xa302 ExifValue -> Text
forall a. Show a => a -> Text
showT
customRendered :: ExifTag
customRendered          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"customRendered" Word16
0xa401 ExifValue -> Text
ppCustomRendered
exposureMode :: ExifTag
exposureMode            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exposureMode" Word16
0xa402 ExifValue -> Text
ppExposureMode
whiteBalance :: ExifTag
whiteBalance            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"whiteBalance" Word16
0xa403 ExifValue -> Text
ppWhiteBalance
digitalZoomRatio :: ExifTag
digitalZoomRatio        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"digitalZoomRatio" Word16
0xa404 ExifValue -> Text
forall a. Show a => a -> Text
showT
focalLengthIn35mmFilm :: ExifTag
focalLengthIn35mmFilm   = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"focalLengthIn35mmFilm" Word16
0xa405 ((ExifValue -> Text) -> ExifTag) -> (ExifValue -> Text) -> ExifTag
forall a b. (a -> b) -> a -> b
$ String -> ExifValue -> Text
asFpWithFormat String
"%s mm"
sceneCaptureType :: ExifTag
sceneCaptureType        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"sceneCaptureType" Word16
0xa406 ExifValue -> Text
ppSceneCaptureType
gainControl :: ExifTag
gainControl             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"gainControl" Word16
0xa407 ExifValue -> Text
ppGainControl
contrast :: ExifTag
contrast                = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"contrast" Word16
0xa408 ExifValue -> Text
ppContrastSharpness
saturation :: ExifTag
saturation              = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"saturation" Word16
0xa409 ExifValue -> Text
ppSaturation
sharpness :: ExifTag
sharpness               = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"sharpness" Word16
0xa40a ExifValue -> Text
ppContrastSharpness
deviceSettingDescription :: ExifTag
deviceSettingDescription= String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"deviceSettingDescription" Word16
0xa40b ExifValue -> Text
forall a. Show a => a -> Text
showT
subjectDistanceRange :: ExifTag
subjectDistanceRange    = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"subjectDistanceRange" Word16
0xa40c ExifValue -> Text
ppSubjectDistanceRange
imageUniqueId :: ExifTag
imageUniqueId           = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"imageUniqueId" Word16
0xa420 ExifValue -> Text
forall a. Show a => a -> Text
showT
exifInteroperabilityOffset :: ExifTag
exifInteroperabilityOffset=String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifSubIfdTag String
"exifInteroperabilityOffset" Word16
0xa005 ExifValue -> Text
forall a. Show a => a -> Text
showT

imageDescription :: ExifTag
imageDescription        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"imageDescription" Word16
0x010e ExifValue -> Text
forall a. Show a => a -> Text
showT
make :: ExifTag
make                    = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"make" Word16
0x010f ExifValue -> Text
forall a. Show a => a -> Text
showT
model :: ExifTag
model                   = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"model" Word16
0x0110 ExifValue -> Text
forall a. Show a => a -> Text
showT
orientation :: ExifTag
orientation             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"orientation" Word16
0x0112 ExifValue -> Text
ppOrientation
xResolution :: ExifTag
xResolution             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"xResolution" Word16
0x011a ExifValue -> Text
forall a. Show a => a -> Text
showT
yResolution :: ExifTag
yResolution             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"xResolution" Word16
0x011b ExifValue -> Text
forall a. Show a => a -> Text
showT
resolutionUnit :: ExifTag
resolutionUnit          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"resolutionUnit" Word16
0x0128 ExifValue -> Text
ppResolutionUnit
software :: ExifTag
software                = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"software" Word16
0x0131 ExifValue -> Text
forall a. Show a => a -> Text
showT
dateTime :: ExifTag
dateTime                = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"dateTime" Word16
0x0132 ExifValue -> Text
forall a. Show a => a -> Text
showT
artist :: ExifTag
artist                  = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"artist" Word16
0x013b ExifValue -> Text
forall a. Show a => a -> Text
showT
whitePoint :: ExifTag
whitePoint              = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"whitePoint" Word16
0x013e ExifValue -> Text
forall a. Show a => a -> Text
showT
primaryChromaticities :: ExifTag
primaryChromaticities   = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"primaryChromaticities" Word16
0x013f ExifValue -> Text
forall a. Show a => a -> Text
showT
yCbCrCoefficients :: ExifTag
yCbCrCoefficients       = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"yCbCrCoefficients" Word16
0x0211 ExifValue -> Text
forall a. Show a => a -> Text
showT
yCbCrPositioning :: ExifTag
yCbCrPositioning        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"yCbCrPositioning" Word16
0x0213 ExifValue -> Text
ppYCbCrPositioning
referenceBlackWhite :: ExifTag
referenceBlackWhite     = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"referenceBlackWhite" Word16
0x0214 ExifValue -> Text
forall a. Show a => a -> Text
showT
copyright :: ExifTag
copyright               = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"copyright" Word16
0x8298 ExifValue -> Text
forall a. Show a => a -> Text
showT
printImageMatching :: ExifTag
printImageMatching      = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifIfd0Tag String
"printImageMatching" Word16
0xc4a5 ExifValue -> Text
ppUndef

gpsVersionID :: ExifTag
gpsVersionID            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsVersionID" Word16
0x0000 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsLatitudeRef :: ExifTag
gpsLatitudeRef          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsLatitudeRef" Word16
0x0001 ExifValue -> Text
ppGpsLatitudeRef
gpsLatitude :: ExifTag
gpsLatitude             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsLatitude" Word16
0x0002 ExifValue -> Text
ppGpsLongLat
gpsLongitudeRef :: ExifTag
gpsLongitudeRef         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsLongitudeRef" Word16
0x0003 ExifValue -> Text
ppGpsLongitudeRef
gpsLongitude :: ExifTag
gpsLongitude            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsLongitude" Word16
0x0004 ExifValue -> Text
ppGpsLongLat
gpsAltitudeRef :: ExifTag
gpsAltitudeRef          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsAltitudeRef" Word16
0x0005 ExifValue -> Text
ppGpsAltitudeRef
gpsAltitude :: ExifTag
gpsAltitude             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsAltitude" Word16
0x0006 (String -> Text
T.pack (String -> Text) -> (ExifValue -> String) -> ExifValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExifValue -> String
formatAsFloatingPoint Int
4)
gpsTimeStamp :: ExifTag
gpsTimeStamp            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsTimeStamp" Word16
0x0007 ExifValue -> Text
ppGpsTimeStamp
gpsSatellites :: ExifTag
gpsSatellites           = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsSatellites" Word16
0x0008 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsStatus :: ExifTag
gpsStatus               = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsStatus" Word16
0x0009 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsMeasureMode :: ExifTag
gpsMeasureMode          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsMeasureMode" Word16
0x000a ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDop :: ExifTag
gpsDop                  = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDop" Word16
0x000b ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsSpeedRef :: ExifTag
gpsSpeedRef             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsSpeedRef" Word16
0x000c ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsSpeed :: ExifTag
gpsSpeed                = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsSpeed" Word16
0x000d ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsTrackRef :: ExifTag
gpsTrackRef             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsTrackRef" Word16
0x000e ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsTrack :: ExifTag
gpsTrack                = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsTrack" Word16
0x000f ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsImgDirectionRef :: ExifTag
gpsImgDirectionRef      = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsImgDirectionRef" Word16
0x0010 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsImgDirection :: ExifTag
gpsImgDirection         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsImgDirection" Word16
0x0011 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsMapDatum :: ExifTag
gpsMapDatum             = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsMapDatum" Word16
0x0012 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestLatitudeRef :: ExifTag
gpsDestLatitudeRef      = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestLatitudeRef" Word16
0x0013 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestLatitude :: ExifTag
gpsDestLatitude         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestLatitude" Word16
0x0014 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestLongitudeRef :: ExifTag
gpsDestLongitudeRef     = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestLongitudeRef" Word16
0x0015 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestLongitude :: ExifTag
gpsDestLongitude        = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestLongitude" Word16
0x0016 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestBearingRef :: ExifTag
gpsDestBearingRef       = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestBearingRef" Word16
0x0017 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestBearing :: ExifTag
gpsDestBearing          = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestBearing" Word16
0x0018 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestDistanceRef :: ExifTag
gpsDestDistanceRef      = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestDistanceRef" Word16
0x0019 ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDestDistance :: ExifTag
gpsDestDistance         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDestDistance" Word16
0x001a ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsProcessingMethod :: ExifTag
gpsProcessingMethod     = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsProcessingMethod" Word16
0x001b ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsAreaInformation :: ExifTag
gpsAreaInformation      = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsAreaInformation" Word16
0x001c ExifValue -> Text
forall a. Show a => a -> Text
showT
gpsDateStamp :: ExifTag
gpsDateStamp            = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDateStamp" Word16
0x001d ExifValue -> Text
ppGpsDateStamp
gpsDifferential :: ExifTag
gpsDifferential         = String -> Word16 -> (ExifValue -> Text) -> ExifTag
exifGpsTag String
"gpsDifferential" Word16
0x001e ExifValue -> Text
forall a. Show a => a -> Text
showT

allExifTags :: [ExifTag]
allExifTags :: [ExifTag]
allExifTags = [ExifTag
exposureTime, ExifTag
fnumber, ExifTag
exposureProgram, ExifTag
isoSpeedRatings,
    ExifTag
exifVersion, ExifTag
dateTimeOriginal, ExifTag
dateTimeDigitized, ExifTag
componentConfiguration,
    ExifTag
compressedBitsPerPixel, ExifTag
shutterSpeedValue, ExifTag
apertureValue, ExifTag
brightnessValue,
    ExifTag
exposureBiasValue, ExifTag
maxApertureValue, ExifTag
subjectDistance, ExifTag
meteringMode,
    ExifTag
lightSource, ExifTag
flash, ExifTag
focalLength, ExifTag
makerNote, ExifTag
userComment,
    ExifTag
exifImageWidth, ExifTag
exifImageHeight, ExifTag
relatedSoundFile, ExifTag
focalPlaneXResolution,
    ExifTag
focalPlaneYResolution, ExifTag
focalPlaneResolutionUnit, ExifTag
sensingMethod, ExifTag
fileSource,
    ExifTag
sceneType, ExifTag
orientation, ExifTag
make, ExifTag
model, ExifTag
software, ExifTag
copyright,
    ExifTag
spectralSensitivity, ExifTag
oecf, ExifTag
subjectArea, ExifTag
subSecTime, ExifTag
subSecTimeOriginal,
    ExifTag
subSecTimeDigitized, ExifTag
flashPixVersion, ExifTag
colorSpace, ExifTag
flashEnergy,
    ExifTag
spatialFrequencyResponse, ExifTag
subjectLocation, ExifTag
exposureIndex, ExifTag
cfaPattern,
    ExifTag
customRendered, ExifTag
exposureMode, ExifTag
whiteBalance, ExifTag
digitalZoomRatio,
    ExifTag
focalLengthIn35mmFilm, ExifTag
sceneCaptureType, ExifTag
gainControl, ExifTag
contrast,
    ExifTag
saturation, ExifTag
sharpness, ExifTag
deviceSettingDescription, ExifTag
subjectDistanceRange,
    ExifTag
imageUniqueId, ExifTag
exifInteroperabilityOffset, ExifTag
imageDescription,
    ExifTag
xResolution, ExifTag
yResolution, ExifTag
resolutionUnit, ExifTag
dateTime, ExifTag
whitePoint,
    ExifTag
primaryChromaticities, ExifTag
yCbCrPositioning, ExifTag
yCbCrCoefficients, ExifTag
referenceBlackWhite,
    ExifTag
printImageMatching, ExifTag
artist,
    ExifTag
gpsVersionID, ExifTag
gpsLatitudeRef, ExifTag
gpsLatitude, ExifTag
gpsLongitudeRef, ExifTag
gpsLongitude,
    ExifTag
gpsAltitudeRef, ExifTag
gpsAltitude, ExifTag
gpsTimeStamp, ExifTag
gpsSatellites, ExifTag
gpsStatus,
    ExifTag
gpsMeasureMode, ExifTag
gpsDop, ExifTag
gpsSpeedRef, ExifTag
gpsSpeed, ExifTag
gpsTrackRef, ExifTag
gpsTrack,
    ExifTag
gpsImgDirectionRef, ExifTag
gpsImgDirection, ExifTag
gpsMapDatum, ExifTag
gpsDestLatitudeRef,
    ExifTag
gpsDestLatitude, ExifTag
gpsDestLongitudeRef, ExifTag
gpsDestLongitude, ExifTag
gpsDestBearingRef,
    ExifTag
gpsDestBearing, ExifTag
gpsDestDistanceRef, ExifTag
gpsDestDistance, ExifTag
gpsProcessingMethod,
    ExifTag
gpsAreaInformation, ExifTag
gpsDateStamp, ExifTag
gpsDifferential]

-- | Extract the GPS latitude and longitude where the picture was taken
-- (if it is present in the EXIF)
getGpsLatitudeLongitude :: Map ExifTag ExifValue -> Maybe (Double, Double)
getGpsLatitudeLongitude :: Map ExifTag ExifValue -> Maybe (Double, Double)
getGpsLatitudeLongitude Map ExifTag ExifValue
exifData = do
    (ExifText String
latRef) <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
gpsLatitudeRef Map ExifTag ExifValue
exifData
    Double
latDec <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
gpsLatitude Map ExifTag ExifValue
exifData Maybe ExifValue -> (ExifValue -> Maybe Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExifValue -> Maybe Double
gpsDecodeToDecimalDegrees
    let signedLatDec :: Double
signedLatDec = if String
latRef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"S" then -Double
latDec else Double
latDec
    (ExifText String
longRef) <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
gpsLongitudeRef Map ExifTag ExifValue
exifData
    Double
longDec <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
gpsLongitude Map ExifTag ExifValue
exifData Maybe ExifValue -> (ExifValue -> Maybe Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExifValue -> Maybe Double
gpsDecodeToDecimalDegrees
    let signedLongDec :: Double
signedLongDec = if String
longRef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"W" then -Double
longDec else Double
longDec
    (Double, Double) -> Maybe (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
signedLatDec, Double
signedLongDec)

gpsLongLatToCoords :: ExifValue -> Maybe (Double, Double, Double)
gpsLongLatToCoords :: ExifValue -> Maybe (Double, Double, Double)
gpsLongLatToCoords (ExifRationalList [(Int, Int)]
intPairs) = case ((Int, Int) -> Double) -> [(Int, Int)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Double
forall a a a. (Fractional a, Integral a, Integral a) => (a, a) -> a
intPairToFloating [(Int, Int)]
intPairs of
    [Double
degrees, Double
minutes, Double
seconds] -> (Double, Double, Double) -> Maybe (Double, Double, Double)
forall a. a -> Maybe a
Just (Double
degrees, Double
minutes, Double
seconds)
    [Double]
_ -> Maybe (Double, Double, Double)
forall a. Maybe a
Nothing
    where
        intPairToFloating :: (a, a) -> a
intPairToFloating (a
n, a
d) = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d
gpsLongLatToCoords ExifValue
_ = Maybe (Double, Double, Double)
forall a. Maybe a
Nothing

gpsDecodeToDecimalDegrees :: ExifValue -> Maybe Double
gpsDecodeToDecimalDegrees :: ExifValue -> Maybe Double
gpsDecodeToDecimalDegrees ExifValue
v = do
    (Double
degrees, Double
minutes, Double
seconds) <- ExifValue -> Maybe (Double, Double, Double)
gpsLongLatToCoords ExifValue
v
    Double -> Maybe Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
degrees Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
minutes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
seconds Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3600

ppGpsLongLat :: ExifValue -> Text
ppGpsLongLat :: ExifValue -> Text
ppGpsLongLat ExifValue
x = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Invalid GPS data" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ExifValue -> Maybe Text
_ppGpsLongLat ExifValue
x

_ppGpsLongLat :: ExifValue -> Maybe Text
_ppGpsLongLat :: ExifValue -> Maybe Text
_ppGpsLongLat ExifValue
v = do
    (Double
degrees, Double
minutes, Double
seconds) <- ExifValue -> Maybe (Double, Double, Double)
gpsLongLatToCoords ExifValue
v
    Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.0f° %.0f' %.2f\"" Double
degrees Double
minutes Double
seconds

-- | Extract the GPS date time, if present in the picture.
getGpsDateTime :: Map ExifTag ExifValue -> Maybe LocalTime
getGpsDateTime :: Map ExifTag ExifValue -> Maybe LocalTime
getGpsDateTime Map ExifTag ExifValue
exifData = do
    Day
gpsDate <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
gpsDateStamp Map ExifTag ExifValue
exifData Maybe ExifValue -> (ExifValue -> Maybe Day) -> Maybe Day
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExifValue -> Maybe Day
parseGpsDate
    TimeOfDay
gpsTime <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
gpsTimeStamp Map ExifTag ExifValue
exifData Maybe ExifValue
-> (ExifValue -> Maybe TimeOfDay) -> Maybe TimeOfDay
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExifValue -> Maybe TimeOfDay
parseGpsTime
    LocalTime -> Maybe LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> Maybe LocalTime) -> LocalTime -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
gpsDate TimeOfDay
gpsTime

parseGpsDate :: ExifValue -> Maybe Day
parseGpsDate :: ExifValue -> Maybe Day
parseGpsDate (ExifText String
dateStr) = Get Day -> ByteString -> Maybe Day
forall a. Get a -> ByteString -> Maybe a
runMaybeGet Get Day
getExifDate (ByteString -> Maybe Day) -> ByteString -> Maybe Day
forall a b. (a -> b) -> a -> b
$ String -> ByteString
stringToByteString String
dateStr
parseGpsDate ExifValue
_ = Maybe Day
forall a. Maybe a
Nothing

getExifDate :: Get Day
getExifDate :: Get Day
getExifDate = do
    Integer
year  <- Int -> Get Integer
forall a. Read a => Int -> Get a
readDigit Int
4
    Int
month <- Char -> Get Char
getCharValue Char
':' Get Char -> Get Int -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Int
forall a. Read a => Int -> Get a
readDigit Int
2
    Int
day   <- Char -> Get Char
getCharValue Char
':' Get Char -> Get Int -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Int
forall a. Read a => Int -> Get a
readDigit Int
2
    Day -> Get Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Get Day) -> Day -> Get Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day

-- | read the GPS time from the 'gpsTimeStamp' field.
parseGpsTime :: ExifValue -> Maybe TimeOfDay
parseGpsTime :: ExifValue -> Maybe TimeOfDay
parseGpsTime (ExifRationalList [(Int
hr_n, Int
hr_d), (Int
min_n, Int
min_d), (Int
sec_n, Int
sec_d)]) =
    TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
hr_n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
hr_d) (Int
min_n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
min_d) (Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sec_n Pico -> Pico -> Pico
forall a. Fractional a => a -> a -> a
/ Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sec_d)
parseGpsTime ExifValue
_ = Maybe TimeOfDay
forall a. Maybe a
Nothing

ppGpsTimeStamp :: ExifValue -> Text
ppGpsTimeStamp :: ExifValue -> Text
ppGpsTimeStamp ExifValue
exifV = Text -> (TimeOfDay -> Text) -> Maybe TimeOfDay -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"invalid" (String -> Text
T.pack (String -> Text) -> (TimeOfDay -> String) -> TimeOfDay -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> String
forall t. PrintfType t => TimeOfDay -> t
formatTod) (Maybe TimeOfDay -> Text) -> Maybe TimeOfDay -> Text
forall a b. (a -> b) -> a -> b
$ ExifValue -> Maybe TimeOfDay
parseGpsTime ExifValue
exifV
    where formatTod :: TimeOfDay -> t
formatTod (TimeOfDay Int
h Int
m Pico
s) = String -> Int -> Int -> Float -> t
forall r. PrintfType r => String -> r
printf String
"%02d:%02d:%02.2f" Int
h Int
m (Pico -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
s :: Float)

ppGpsDateStamp :: ExifValue -> Text
ppGpsDateStamp :: ExifValue -> Text
ppGpsDateStamp ExifValue
exifV = Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"invalid" (String -> Text
T.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Int, Int) -> String
forall t t t t.
(PrintfArg t, PrintfArg t, PrintfArg t, PrintfType t) =>
(t, t, t) -> t
formatDay ((Integer, Int, Int) -> String)
-> (Day -> (Integer, Int, Int)) -> Day -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian) (Maybe Day -> Text) -> Maybe Day -> Text
forall a b. (a -> b) -> a -> b
$ ExifValue -> Maybe Day
parseGpsDate ExifValue
exifV
    where formatDay :: (t, t, t) -> t
formatDay (t
year, t
month, t
day) = String -> t -> t -> t -> t
forall r. PrintfType r => String -> r
printf String
"%d-%02d-%02d" t
year t
month t
day

ppGpsLatitudeRef :: ExifValue -> Text
ppGpsLatitudeRef :: ExifValue -> Text
ppGpsLatitudeRef (ExifText String
"N") = Text
"North"
ppGpsLatitudeRef (ExifText String
"S") = Text
"South"
ppGpsLatitudeRef v :: ExifValue
v@ExifValue
_ = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Invalid latitude: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExifValue -> String
forall a. Show a => a -> String
show ExifValue
v

ppGpsLongitudeRef :: ExifValue -> Text
ppGpsLongitudeRef :: ExifValue -> Text
ppGpsLongitudeRef (ExifText String
"E") = Text
"East"
ppGpsLongitudeRef (ExifText String
"W") = Text
"West"
ppGpsLongitudeRef v :: ExifValue
v@ExifValue
_ = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Invalid longitude: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExifValue -> String
forall a. Show a => a -> String
show ExifValue
v