{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, CPP #-}
module Graphics.PrettyPrinters where

import Text.Printf (printf)
import Data.Map (Map)
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.ByteString as BS
import Control.Arrow (first)
import Data.Text.Encoding
import qualified Data.Text as T
import Data.Text (Text)
#if ICONV
import qualified Data.ByteString.Lazy as BL
import Codec.Text.IConv (convertFuzzy, EncodingName, Fuzzy(Transliterate))
#endif

import Graphics.Types (ExifValue(..), formatAsFloatingPoint, formatAsNumber)

-- ! Pretty print the undefined data
ppUndef :: ExifValue -> Text
ppUndef :: ExifValue -> Text
ppUndef (ExifUndefined ByteString
str) = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
str) Text -> Text -> Text
`T.append` Text
" bytes undefined data"
ppUndef ExifValue
_ = Text
"undefined data"

ppResolutionUnit :: ExifValue -> Text
ppResolutionUnit :: ExifValue -> Text
ppResolutionUnit = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"No absolute unit"),
            (Int
2, Text
"Inch"),
            (Int
3, Text
"Centimeter")]

ppYCbCrPositioning :: ExifValue -> Text
ppYCbCrPositioning :: ExifValue -> Text
ppYCbCrPositioning = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"Centered"), (Int
2, Text
"Co-sited")]

ppAperture :: ExifValue -> Text
ppAperture :: ExifValue -> Text
ppAperture = 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
"f/%s" (String -> String) -> (ExifValue -> String) -> ExifValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ExifValue -> String
formatAsFloatingPoint Int
1

-- ! Pretty-print aperture stored as APEX value.
-- See: https://photo.stackexchange.com/questions/19143/how-can-the-aperture-value-written-in-exif-be-larger-than-the-nominal-limit-of-t
ppApexAperture :: ExifValue -> Text
ppApexAperture :: ExifValue -> Text
ppApexAperture ExifValue
v = String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"f/%.1f" Double
fnumber)
  where
    doubleValue :: ExifValue -> Double
    doubleValue :: ExifValue -> Double
doubleValue (ExifNumber Int
n) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    doubleValue (ExifRational Int
n Int
d) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d
    doubleValue ExifValue
_ = Double
0
    apex :: Double
apex = ExifValue -> Double
doubleValue ExifValue
v
    fnumber :: Double
fnumber = Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
apex Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)

-- ! Pretty print exposure time.
-- Formats times slower than 1/4 with one decimal place and
-- faster times as fractions.
-- Examples: "4 sec.", "1/125 sec.", "0.8 sec."
ppExposureTime :: ExifValue -> Text
ppExposureTime :: ExifValue -> Text
ppExposureTime v :: ExifValue
v@(ExifRational Int
num Int
den)
           = let seconds :: Double
seconds = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
den :: Double)
                 value :: String
value | Double
seconds Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.25 Bool -> Bool -> Bool
&& Double
seconds Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = String
"1/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ((Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
seconds)) :: Int)
                       | Bool
otherwise = Int -> ExifValue -> String
formatAsNumber Int
1 ExifValue
v
             in Text -> Text -> Text
T.append (String -> Text
T.pack String
value) Text
" sec."
ppExposureTime ExifValue
v = String -> Text
T.pack (ExifValue -> String
forall a. Show a => a -> String
show ExifValue
v)

ppExposureProgram :: ExifValue -> Text
ppExposureProgram :: ExifValue -> Text
ppExposureProgram = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Not defined"),
            (Int
1, Text
"Manual"),
            (Int
2, Text
"Normal program"),
            (Int
3, Text
"Aperture priority"),
            (Int
4, Text
"Shutter priority"),
            (Int
5, Text
"Creative program (biased toward depth of field)"),
            (Int
6, Text
"Action program (biased toward fast shutter speed)"),
            (Int
7, Text
"Portrait mode (for closeup photos with the background out of focus)"),
            (Int
8, Text
"Landscape mode (for landscape photos with the background in focus)")]

ppMeteringMode :: ExifValue -> Text
ppMeteringMode :: ExifValue -> Text
ppMeteringMode = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Unknown"),
            (Int
1, Text
"Average"),
            (Int
2, Text
"Center-weighted average"),
            (Int
3, Text
"Spot"),
            (Int
4, Text
"MultiSpot"),
            (Int
5, Text
"Pattern"),
            (Int
6, Text
"Partial"),
            (Int
255, Text
"other")]

ppLightSource :: ExifValue -> Text
ppLightSource :: ExifValue -> Text
ppLightSource = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Unknown"),
            (Int
1, Text
"Daylight"),
            (Int
2, Text
"Fluorescent"),
            (Int
3, Text
"Tungsten (incandescent light)"),
            (Int
4, Text
"Flash"),
            (Int
9, Text
"Fine weather"),
            (Int
10, Text
"Cloudy weather"),
            (Int
11, Text
"Shade"),
            (Int
12, Text
"Daylight fluorescent (D 5700 - 7100K)"),
            (Int
13, Text
"Day white fluorescent (N 4600 - 5400K)"),
            (Int
14, Text
"Cool white fluorescent (W 3900 - 4500K)"),
            (Int
15, Text
"White fluorescent (WW 3200 - 3700K)"),
            (Int
17, Text
"Standard light A"),
            (Int
18, Text
"Standard light B"),
            (Int
19, Text
"Standard light C"),
            (Int
20, Text
"D55"),
            (Int
21, Text
"D65"),
            (Int
22, Text
"D75"),
            (Int
23, Text
"D50"),
            (Int
24, Text
"ISO studio tungsten"),
            (Int
255, Text
"Other light source")]

ppFlash :: ExifValue -> Text
ppFlash :: ExifValue -> Text
ppFlash = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Flash did not fire"),
            (Int
1, Text
"Flash fired"),
            (Int
5, Text
"Strobe return light not detected"),
            (Int
7, Text
"Strobe return light detected"),
            (Int
9, Text
"Flash fired, compulsory flash mode"),
            (Int
0x0D, Text
"Flash fired, compulsory flash mode, return light not detected"),
            (Int
0x0F, Text
"Flash fired, compulsory flash mode, return light detected"),
            (Int
0x10, Text
"Flash did not fire, compulsory flash mode"),
            (Int
0x18, Text
"Flash did not fire, auto mode"),
            (Int
0x19, Text
"Flash fired, auto mode"),
            (Int
0x1D, Text
"Flash fired, auto mode, return light not detected"),
            (Int
0x1F, Text
"Flash fired, auto mode, return light detected"),
            (Int
0x20, Text
"No flash function"),
            (Int
0x41, Text
"Flash fired, red-eye reduction mode"),
            (Int
0x45, Text
"Flash fired, red-eye reduction mode, return light not detected"),
            (Int
0x47, Text
"Flash fired, red-eye reduction mode, return light detected"),
            (Int
0x49, Text
"Flash fired, compulsory flash mode, red-eye reduction mode"),
            (Int
0x4D, Text
"Flash fired, compulsory flash mode, red-eye reduction mode, return light not detected"),
            (Int
0x4F, Text
"Flash fired, compulsory flash mode, red-eye reduction mode, return light detected"),
            (Int
0x59, Text
"Flash fired, auto mode, red-eye reduction mode"),
            (Int
0x5D, Text
"Flash fired, auto mode, return light not detected, red-eye reduction mode"),
            (Int
0x5F, Text
"Flash fired, auto mode, return light detected, red-eye reduction mode")]

ppColorSpace :: ExifValue -> Text
ppColorSpace :: ExifValue -> Text
ppColorSpace = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"sRGB"), (Int
65535, Text
"Uncalibrated")]

ppCustomRendered :: ExifValue -> Text
ppCustomRendered :: ExifValue -> Text
ppCustomRendered = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Normal process"), (Int
1, Text
"Custom process")]

ppExposureMode :: ExifValue -> Text
ppExposureMode :: ExifValue -> Text
ppExposureMode = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Auto exposure"),
            (Int
1, Text
"Manual exposure"),
            (Int
2, Text
"Auto bracket")]

ppWhiteBalance :: ExifValue -> Text
ppWhiteBalance :: ExifValue -> Text
ppWhiteBalance = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Auto white balance"),
            (Int
1, Text
"Manual white balance")]

ppSceneCaptureType :: ExifValue -> Text
ppSceneCaptureType :: ExifValue -> Text
ppSceneCaptureType = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Standard"),
            (Int
1, Text
"Landscape"),
            (Int
2, Text
"Portrait"),
            (Int
3, Text
"Night scene")]

ppGainControl :: ExifValue -> Text
ppGainControl :: ExifValue -> Text
ppGainControl = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Normal"),
            (Int
1, Text
"Low gain up"),
            (Int
2, Text
"High gain up"),
            (Int
3, Text
"Low gain down"),
            (Int
4, Text
"High gain down")]

ppContrastSharpness :: ExifValue -> Text
ppContrastSharpness :: ExifValue -> Text
ppContrastSharpness = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Normal"), (Int
1, Text
"Soft"), (Int
2, Text
"Hard")]

ppSaturation :: ExifValue -> Text
ppSaturation :: ExifValue -> Text
ppSaturation = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Normal"),
            (Int
1, Text
"Low saturation"),
            (Int
2, Text
"High saturation")]

ppSensingMethod :: ExifValue -> Text
ppSensingMethod :: ExifValue -> Text
ppSensingMethod = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"Not defined"),
            (Int
2, Text
"One-chip color area sensor"),
            (Int
3, Text
"Two-chip color area sensor"),
            (Int
4, Text
"Three-chip color area sensor"),
            (Int
5, Text
"Color sequential area sensor"),
            (Int
7, Text
"Trilinear sensor"),
            (Int
8, Text
"Color sequential linear sensor")]

ppSubjectDistanceRange :: ExifValue -> Text
ppSubjectDistanceRange :: ExifValue -> Text
ppSubjectDistanceRange = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Unknown"),
            (Int
1, Text
"Macro"),
            (Int
2, Text
"Close view"),
            (Int
3, Text
"Distance view")]

ppFocalPlaneResolutionUnit :: ExifValue -> Text
ppFocalPlaneResolutionUnit :: ExifValue -> Text
ppFocalPlaneResolutionUnit = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"No absolute unit of measurement"),
            (Int
2, Text
"Inch"),
            (Int
3, Text
"Centimeter")]

ppOrientation :: ExifValue -> Text
ppOrientation :: ExifValue -> Text
ppOrientation = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"Top-left"),
            (Int
2, Text
"Top-right"),
            (Int
3, Text
"Bottom-right"),
            (Int
4, Text
"Bottom-left"),
            (Int
5, Text
"Left-top"),
            (Int
6, Text
"Right-top"),
            (Int
7, Text
"Right-bottom"),
            (Int
8, Text
"Left-bottom")]

ppSceneType :: ExifValue -> Text
ppSceneType :: ExifValue -> Text
ppSceneType = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
1, Text
"Directly photographed")]

ppGpsAltitudeRef :: ExifValue -> Text
ppGpsAltitudeRef :: ExifValue -> Text
ppGpsAltitudeRef = [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int
0, Text
"Sea level"),
                (Int
1, Text
"Below sea level")]

componentMap :: Map Int Text
componentMap :: Map Int Text
componentMap = [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Text)] -> Map Int Text) -> [(Int, Text)] -> Map Int Text
forall a b. (a -> b) -> a -> b
$ [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Text
"-", Text
"Y", Text
"Cb", Text
"Cr", Text
"R", Text
"G", Text
"B"]

ppComponentConfiguration :: ExifValue -> Text
ppComponentConfiguration :: ExifValue -> Text
ppComponentConfiguration (ExifUndefined ByteString
bs) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
formatComponent [Int]
numbers
    where
        numbers :: [Int]
numbers = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> [Word8] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [Word8]
BS.unpack ByteString
bs
        formatComponent :: Int -> Text
formatComponent = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"?" (Maybe Text -> Text) -> (Int -> Maybe Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Map Int Text -> Maybe Text)
-> Map Int Text -> Int -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Int Text
componentMap
ppComponentConfiguration v :: ExifValue
v@ExifValue
_ = ExifValue -> Text
forall a. Show a => a -> Text
unknown ExifValue
v

ppFlashPixVersion :: ExifValue -> Text
ppFlashPixVersion :: ExifValue -> Text
ppFlashPixVersion = String -> ExifValue -> Text
formatVersion String
"FlashPix version %.1f"

ppExifVersion :: ExifValue -> Text
ppExifVersion :: ExifValue -> Text
ppExifVersion = String -> ExifValue -> Text
formatVersion String
"Exif version %.2f"

formatVersion :: String -> ExifValue -> Text
formatVersion :: String -> ExifValue -> Text
formatVersion String
fmt (ExifUndefined ByteString
s) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Float -> String
forall r. PrintfType r => String -> r
printf String
fmt Float
num
    where
        Float
num :: Float = String -> Float
forall a. Read a => String -> a
read String
asStr Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100.0
        asStr :: String
asStr = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
s
formatVersion String
_ v :: ExifValue
v@ExifValue
_ = ExifValue -> Text
forall a. Show a => a -> Text
unknown ExifValue
v

#if ICONV

getIconvEncodingName :: Text -> EncodingName
getIconvEncodingName :: Text -> String
getIconvEncodingName Text
"JIS" = String
"SJIS"
getIconvEncodingName x :: Text
x@Text
_ = Text -> String
T.unpack Text
x -- ASCII and UNICODE work out of the box.

ppUserComment :: ExifValue -> Text
ppUserComment :: ExifValue -> Text
ppUserComment (ExifUndefined ByteString
v) = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Fuzzy -> String -> String -> ByteString -> ByteString
convertFuzzy Fuzzy
Transliterate String
encoding String
"UTF8" ByteString
rawText
    where
        encoding :: String
encoding = Text -> String
getIconvEncodingName (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
8 ByteString
v
        rawText :: ByteString
rawText = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
v
ppUserComment v :: ExifValue
v@ExifValue
_ = ExifValue -> Text
forall a. Show a => a -> Text
unknown ExifValue
v

#else

ppUserComment :: ExifValue -> Text
ppUserComment (ExifUndefined v) = decodeUtf8 $ BS.drop 8 v
ppUserComment v@_ = unknown v

#endif

-- | Pretty printer for the FileSource tag
ppFileSource :: ExifValue -> Text
ppFileSource :: ExifValue -> Text
ppFileSource (ExifUndefined ByteString
v)
    | ByteString -> Word8
BS.head ByteString
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 = Text
"DSC"
    | Bool
otherwise      = Text
"(unknown)"
ppFileSource ExifValue
v = ExifValue -> Text
forall a. Show a => a -> Text
unknown ExifValue
v

fromNumberMap :: [(Int, Text)] -> ExifValue -> Text
fromNumberMap :: [(Int, Text)] -> ExifValue -> Text
fromNumberMap [(Int, Text)]
m = [(ExifValue, Text)] -> ExifValue -> Text
fromMap [(ExifValue, Text)]
convertedMap
    where convertedMap :: [(ExifValue, Text)]
convertedMap = ((Int, Text) -> (ExifValue, Text))
-> [(Int, Text)] -> [(ExifValue, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> ExifValue) -> (Int, Text) -> (ExifValue, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> ExifValue
ExifNumber) [(Int, Text)]
m

fromMap :: [(ExifValue, Text)] -> ExifValue -> Text
fromMap :: [(ExifValue, Text)] -> ExifValue -> Text
fromMap [(ExifValue, Text)]
m ExifValue
v = Text -> ExifValue -> Map ExifValue Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (ExifValue -> Text
forall a. Show a => a -> Text
unknown ExifValue
v) ExifValue
v (Map ExifValue Text -> Text) -> Map ExifValue Text -> Text
forall a b. (a -> b) -> a -> b
$ [(ExifValue, Text)] -> Map ExifValue Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ExifValue, Text)]
m

unknown :: Show a => a -> Text
unknown :: a -> Text
unknown a
v = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Unknown value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v