module Graphics.Types where

import qualified Data.ByteString as BS
import Data.Word
import Numeric (showHex, showFFloat)
import Data.Function (on)
import Data.Text (Text)

-- | An exif value.
--
-- If you want a string describing the contents
-- of the value, simply use 'show'.
data ExifValue = ExifNumber !Int
    -- ^ An exif number. Originally it could have been short, int, signed or not.
    | ExifText !String
    -- ^ ASCII text.
    | ExifRational !Int !Int
    -- ^ A rational number (numerator, denominator).
    -- Sometimes we're used to it as rational (exposition time: 1/160),
    -- sometimes as float (exposure compensation, we rather think -0.75)
    -- 'show' will display it as 1/160.
    | ExifNumberList ![Int]
    -- ^ List of numbers. Originally they could have been short, int, signed or not.
    | ExifRationalList ![(Int,Int)]
    -- ^ A list of rational numbers (numerator, denominator).
    -- Sometimes we're used to it as rational (exposition time: 1/160),
    -- sometimes as float (exposure compensation, we rather think -0.75)
    -- 'show' will display it as 1/160.
    | ExifUndefined !BS.ByteString
    -- ^ The undefined type in EXIF means that the contents are not
    -- specified and up to the manufacturer. In effect it's exactly
    -- a bytestring. Sometimes it's text with ASCII or UNICODE at the
    -- beginning, often it's binary in nature.
    | ExifUnknown !Word16 !Int !Int
    -- ^ Unknown exif value type. All EXIF 2.3 types are
    -- supported, it could be a newer file.
    -- The parameters are type, count then value
    deriving (ExifValue -> ExifValue -> Bool
(ExifValue -> ExifValue -> Bool)
-> (ExifValue -> ExifValue -> Bool) -> Eq ExifValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExifValue -> ExifValue -> Bool
$c/= :: ExifValue -> ExifValue -> Bool
== :: ExifValue -> ExifValue -> Bool
$c== :: ExifValue -> ExifValue -> Bool
Eq, Eq ExifValue
Eq ExifValue
-> (ExifValue -> ExifValue -> Ordering)
-> (ExifValue -> ExifValue -> Bool)
-> (ExifValue -> ExifValue -> Bool)
-> (ExifValue -> ExifValue -> Bool)
-> (ExifValue -> ExifValue -> Bool)
-> (ExifValue -> ExifValue -> ExifValue)
-> (ExifValue -> ExifValue -> ExifValue)
-> Ord ExifValue
ExifValue -> ExifValue -> Bool
ExifValue -> ExifValue -> Ordering
ExifValue -> ExifValue -> ExifValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExifValue -> ExifValue -> ExifValue
$cmin :: ExifValue -> ExifValue -> ExifValue
max :: ExifValue -> ExifValue -> ExifValue
$cmax :: ExifValue -> ExifValue -> ExifValue
>= :: ExifValue -> ExifValue -> Bool
$c>= :: ExifValue -> ExifValue -> Bool
> :: ExifValue -> ExifValue -> Bool
$c> :: ExifValue -> ExifValue -> Bool
<= :: ExifValue -> ExifValue -> Bool
$c<= :: ExifValue -> ExifValue -> Bool
< :: ExifValue -> ExifValue -> Bool
$c< :: ExifValue -> ExifValue -> Bool
compare :: ExifValue -> ExifValue -> Ordering
$ccompare :: ExifValue -> ExifValue -> Ordering
$cp1Ord :: Eq ExifValue
Ord)

instance Show ExifValue where
    show :: ExifValue -> String
show (ExifNumber Int
v) = Int -> String
forall a. Show a => a -> String
show Int
v
    show (ExifText String
v) = String
v
    show (ExifRational Int
n Int
d) = Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d
    show (ExifUnknown Word16
t Int
c Int
v) = ShowS
forall a. Show a => a -> String
show String
"Unknown exif type. Type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
t
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" count: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v
    show (ExifNumberList [Int]
l) = [Int] -> String
forall a. Show a => a -> String
show [Int]
l
    show (ExifRationalList [(Int, Int)]
l) = [(Int, Int)] -> String
forall a. Show a => a -> String
show [(Int, Int)]
l
    show (ExifUndefined ByteString
bs) = ByteString -> String
forall a. Show a => a -> String
show ByteString
bs

-- | Location of the tag in the JPG file structure.
-- Normally you don't need to fiddle with this,
-- except maybe if the library doesn't know the particular
-- exif tag you're interested in.
-- Rather check the list of supported exif tags, like
-- 'exposureTime' and so on.
data TagLocation = ExifSubIFD | IFD0 | GpsSubIFD
    deriving (Int -> TagLocation -> ShowS
[TagLocation] -> ShowS
TagLocation -> String
(Int -> TagLocation -> ShowS)
-> (TagLocation -> String)
-> ([TagLocation] -> ShowS)
-> Show TagLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagLocation] -> ShowS
$cshowList :: [TagLocation] -> ShowS
show :: TagLocation -> String
$cshow :: TagLocation -> String
showsPrec :: Int -> TagLocation -> ShowS
$cshowsPrec :: Int -> TagLocation -> ShowS
Show, TagLocation -> TagLocation -> Bool
(TagLocation -> TagLocation -> Bool)
-> (TagLocation -> TagLocation -> Bool) -> Eq TagLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagLocation -> TagLocation -> Bool
$c/= :: TagLocation -> TagLocation -> Bool
== :: TagLocation -> TagLocation -> Bool
$c== :: TagLocation -> TagLocation -> Bool
Eq, Eq TagLocation
Eq TagLocation
-> (TagLocation -> TagLocation -> Ordering)
-> (TagLocation -> TagLocation -> Bool)
-> (TagLocation -> TagLocation -> Bool)
-> (TagLocation -> TagLocation -> Bool)
-> (TagLocation -> TagLocation -> Bool)
-> (TagLocation -> TagLocation -> TagLocation)
-> (TagLocation -> TagLocation -> TagLocation)
-> Ord TagLocation
TagLocation -> TagLocation -> Bool
TagLocation -> TagLocation -> Ordering
TagLocation -> TagLocation -> TagLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagLocation -> TagLocation -> TagLocation
$cmin :: TagLocation -> TagLocation -> TagLocation
max :: TagLocation -> TagLocation -> TagLocation
$cmax :: TagLocation -> TagLocation -> TagLocation
>= :: TagLocation -> TagLocation -> Bool
$c>= :: TagLocation -> TagLocation -> Bool
> :: TagLocation -> TagLocation -> Bool
$c> :: TagLocation -> TagLocation -> Bool
<= :: TagLocation -> TagLocation -> Bool
$c<= :: TagLocation -> TagLocation -> Bool
< :: TagLocation -> TagLocation -> Bool
$c< :: TagLocation -> TagLocation -> Bool
compare :: TagLocation -> TagLocation -> Ordering
$ccompare :: TagLocation -> TagLocation -> Ordering
$cp1Ord :: Eq TagLocation
Ord)

-- | An exif tag. Normally you don't need to fiddle with this,
-- except maybe if the library doesn't know the particular
-- exif tag you're interested in.
-- Rather check the list of supported exif tags, like
-- 'exposureTime' and so on.
data ExifTag = ExifTag
    {
        ExifTag -> TagLocation
tagLocation :: TagLocation,
        -- ^ In which part of the JPEG file the exif tag was found
        ExifTag -> Maybe String
tagDesc :: Maybe String,
        -- ^ Description of the exif tag (exposureTime, fnumber...) or if unknown, Nothing.
        -- This should be purely for debugging purposes, to compare tags use == on ExifTag
        -- or compare the tagKey.
        ExifTag -> Word16
tagKey :: Word16,
        -- ^ Exif tag key, the number uniquely identifying this tag.
        ExifTag -> ExifValue -> Text
prettyPrinter :: ExifValue -> Text
        -- ^ A function that'll display nicely an exif value for that exif tag.
        -- For instance for the 'flash' ExifTag, it'll say whether the flash was
        -- fired or not, if there was return light and so on.
    }

instance Show ExifTag where
    show :: ExifTag -> String
show (ExifTag TagLocation
_ (Just String
d) Word16
_ ExifValue -> Text
_) = String
d
    show (ExifTag TagLocation
l Maybe String
_ Word16
v ExifValue -> Text
_) = String
"Unknown tag, location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TagLocation -> String
forall a. Show a => a -> String
show TagLocation
l
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", value: 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word16
v String
""

instance Eq ExifTag where
    ExifTag
t1 == :: ExifTag -> ExifTag -> Bool
== ExifTag
t2 = ExifTag -> Word16
tagKey ExifTag
t1 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag -> Word16
tagKey ExifTag
t2 Bool -> Bool -> Bool
&& ExifTag -> TagLocation
tagLocation ExifTag
t1 TagLocation -> TagLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag -> TagLocation
tagLocation ExifTag
t2

instance Ord ExifTag where
    compare :: ExifTag -> ExifTag -> Ordering
compare ExifTag
t1 ExifTag
t2 = if Ordering
locCmp Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ then Ordering
locCmp else Ordering
tagCmp
        where
            locCmp :: Ordering
locCmp = (TagLocation -> TagLocation -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TagLocation -> TagLocation -> Ordering)
-> (ExifTag -> TagLocation) -> ExifTag -> ExifTag -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ExifTag -> TagLocation
tagLocation) ExifTag
t1 ExifTag
t2
            tagCmp :: Ordering
tagCmp = (Word16 -> Word16 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word16 -> Word16 -> Ordering)
-> (ExifTag -> Word16) -> ExifTag -> ExifTag -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ExifTag -> Word16
tagKey) ExifTag
t1 ExifTag
t2

-- | Format the exif value as floating-point if it makes sense,
-- otherwise use the default 'show' implementation.
-- The first parameter lets you specify how many digits after
-- the comma to format in the result string.
-- The special behaviour applies only for 'ExifRational' and 'ExifRationalList'.
formatAsFloatingPoint :: Int -> ExifValue -> String
formatAsFloatingPoint :: Int -> ExifValue -> String
formatAsFloatingPoint Int
n = (Int -> Int -> ShowS) -> ExifValue -> String
formatNumeric Int -> Int -> ShowS
forall a a. (Integral a, Integral a) => a -> a -> ShowS
fmt
  where
    fmt :: a -> a -> ShowS
fmt a
num a
den = Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
num Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
den :: Double)

-- | Format the exif value as a number if it makes sense,
-- otherwise use the default 'show' implementation.
-- The first parameter lets you specify the maximum number
-- of fractional digits in the result string.
-- This is the same as formatAsfloatingPoint but with trailing
-- zeros stripped from the result.
formatAsNumber :: Int -> ExifValue -> String
formatAsNumber :: Int -> ExifValue -> String
formatAsNumber Int
n = (Int -> Int -> ShowS) -> ExifValue -> String
formatNumeric Int -> Int -> ShowS
forall a a. (Integral a, Integral a) => a -> a -> ShowS
fmt
  where
    fmt :: a -> a -> ShowS
fmt a
num a
den String
s     = ShowS
trim0 (a -> a -> String
forall a a. (Integral a, Integral a) => a -> a -> String
fltString a
num a
den) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    trim0 :: ShowS
trim0             = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'.'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'0'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
    fltString :: a -> a -> String
fltString a
num a
den = Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
num Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
den :: Double) String
""

-- | Format the exif value as normalized rational number if it makes sense,
-- otherwise use the default 'show' implementation.
-- The special behaviour applies only for 'ExifRational' and 'ExifRationalList'.
formatAsRational :: ExifValue -> String
formatAsRational :: ExifValue -> String
formatAsRational ExifValue
value = (Int -> Int -> ShowS) -> ExifValue -> String
formatNumeric Int -> Int -> ShowS
forall a. (Show a, Integral a) => a -> a -> ShowS
format ExifValue
value
  where
    format :: a -> a -> ShowS
format a
num a
den = let d :: a
d = a -> a -> a
forall a. Integral a => a -> a -> a
gcd a
num a
den
                         num' :: a
num' = a
num a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
d
                         den' :: a
den' = a
den a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
d
                     in
                       if a
den' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1
                         then a -> ShowS
forall a. Show a => a -> ShowS
shows a
num'
                         else a -> ShowS
forall a. Show a => a -> ShowS
shows a
num' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'/' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
den'

formatNumeric :: (Int -> Int -> ShowS) -> ExifValue -> String
formatNumeric :: (Int -> Int -> ShowS) -> ExifValue -> String
formatNumeric Int -> Int -> ShowS
f (ExifRational Int
num Int
den)    = Int -> Int -> ShowS
f Int
num Int
den String
""
formatNumeric Int -> Int -> ShowS
f (ExifRationalList [(Int, Int)]
values) = [(Int, Int)] -> ShowS
go [(Int, Int)]
values String
""
  where
    go :: [(Int, Int)] -> ShowS
go []         = ShowS
forall a. a -> a
id
    go [(Int
n,Int
d)]    = Int -> Int -> ShowS
f Int
n Int
d
    go ((Int
n,Int
d):[(Int, Int)]
ns) = Int -> Int -> ShowS
f Int
n Int
d ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> ShowS
go [(Int, Int)]
ns
formatNumeric Int -> Int -> ShowS
_ ExifValue
value                     = ExifValue -> String
forall a. Show a => a -> String
show ExifValue
value