{-# 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 (forall a. Show a => a -> String
show 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"f/%s" 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 (forall r. PrintfType r => String -> r
printf String
"f/%.1f" Double
fnumber)
  where
    doubleValue :: ExifValue -> Double
    doubleValue :: ExifValue -> Double
doubleValue (ExifNumber Int
n) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    doubleValue (ExifRational Int
n Int
d) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ 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 forall a. Floating a => a -> a -> a
** (Double
apex 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
den :: Double)
                 value :: String
value | Double
seconds forall a. Ord a => a -> a -> Bool
<= Double
0.25 Bool -> Bool -> Bool
&& Double
seconds forall a. Ord a => a -> a -> Bool
> Double
0 = String
"1/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
1 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 (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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
formatComponent [Int]
numbers
    where
        numbers :: [Int]
numbers = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [Word8]
BS.unpack ByteString
bs
        formatComponent :: Int -> Text
formatComponent = forall a. a -> Maybe a -> a
fromMaybe Text
"?" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Int Text
componentMap
ppComponentConfiguration ExifValue
v = 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 forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
fmt Float
num
    where
        Float
num :: Float = forall a. Read a => String -> a
read String
asStr forall a. Fractional a => a -> a -> a
/ Float
100.0
        asStr :: String
asStr = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
s
formatVersion String
_ ExifValue
v = forall a. Show a => a -> Text
unknown ExifValue
v

#if ICONV

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

ppUserComment :: ExifValue -> Text
ppUserComment (ExifUndefined v) = decodeUtf8 $ BL.toStrict $ convertFuzzy Transliterate encoding "UTF8" rawText
    where
        encoding = getIconvEncodingName $ decodeUtf8 $ BS.take 8 v
        rawText = BL.fromStrict $ BS.drop 8 v
ppUserComment v = unknown v

#else

ppUserComment :: ExifValue -> Text
ppUserComment :: ExifValue -> Text
ppUserComment (ExifUndefined ByteString
v) = ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
v
ppUserComment ExifValue
v = forall a. Show a => a -> Text
unknown ExifValue
v

#endif

-- | Pretty printer for the FileSource tag
ppFileSource :: ExifValue -> Text
ppFileSource :: ExifValue -> Text
ppFileSource (ExifUndefined ByteString
v)
    | HasCallStack => ByteString -> Word8
BS.head ByteString
v forall a. Eq a => a -> a -> Bool
== Word8
3 = Text
"DSC"
    | Bool
otherwise      = Text
"(unknown)"
ppFileSource ExifValue
v = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. Show a => a -> Text
unknown ExifValue
v) ExifValue
v forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ExifValue, Text)]
m

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