{-|
Module: GoPro.DEVC
Description: Higher level representation of GPMF DEVC data.
Copyright: (c) Dustin Sallings, 2020
License: BSD3
Maintanier: dustin@spy.net
Stability: experimental

DEVC is one of the GPMF data types that contains the bulk of
interesting telemetry data from within GPMF streams.  This module
doesn't currently provide high level access to *all* DEVC data (some
of it remains low level), but it currently has useful representations
of things that seemed interesting to the author.
-}

{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE TypeApplications #-}

module GoPro.DEVC (
  mkDEVC,
  DEVC(..), dev_id, dev_name, dev_telems,
  Accelerometer(..), acc_temp, acc_vals,
  Gyroscope(..), gyro_temp, gyro_vals,
  Face(..), face_id, face_x, face_y, face_w, face_h, face_smile,
  GPSReading(..), gpsr_lat, gpsr_lon, gpsr_alt, gpsr_speed2d, gpsr_speed3d, gpsr_time, gpsr_dop, gpsr_fix, gpsReadings,
  AudioLevel(..), audio_rms, audio_peak,
  Location(..), _Snow, _Urban, _Indoor, _Water, _Vegetation, _Beach,
  TVals(..), _TVUnknown, _TVAccl, _TVGyro, _TVFaces, _TVGPS5, _TVGPS9, _TVAudioLevel, _TVScene,
  Telemetry(..), tele_stmp, tele_tsmp, tele_name, tele_values
  ) where

import           Control.Lens      hiding (cons)
import           Data.Foldable     (fold)
import           Data.List         (transpose)
import           Data.Map.Strict   (Map)
import qualified Data.Map.Strict   as Map
import           Data.Maybe        (fromMaybe, mapMaybe)
import           Data.Time         (UTCTime (..), addDays, addUTCTime, fromGregorian)
import           Data.Word         (Word64)

import           GoPro.GPMF
import           GoPro.GPMF.Lenses

data Accelerometer = Accelerometer
    { Accelerometer -> Float
_acc_temp :: Float
    , Accelerometer -> [(Float, Float, Float)]
_acc_vals :: [(Float, Float, Float)]
    }
    deriving Int -> Accelerometer -> ShowS
[Accelerometer] -> ShowS
Accelerometer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accelerometer] -> ShowS
$cshowList :: [Accelerometer] -> ShowS
show :: Accelerometer -> String
$cshow :: Accelerometer -> String
showsPrec :: Int -> Accelerometer -> ShowS
$cshowsPrec :: Int -> Accelerometer -> ShowS
Show

makeLenses ''Accelerometer

data Gyroscope = Gyroscope
    { Gyroscope -> Float
_gyro_temp :: Float
    , Gyroscope -> [(Float, Float, Float)]
_gyro_vals :: [(Float, Float, Float)]
    }
    deriving Int -> Gyroscope -> ShowS
[Gyroscope] -> ShowS
Gyroscope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gyroscope] -> ShowS
$cshowList :: [Gyroscope] -> ShowS
show :: Gyroscope -> String
$cshow :: Gyroscope -> String
showsPrec :: Int -> Gyroscope -> ShowS
$cshowsPrec :: Int -> Gyroscope -> ShowS
Show

makeLenses ''Gyroscope

data Face = Face
    { Face -> Int
_face_id    :: Int
    , Face -> Float
_face_x     :: Float
    , Face -> Float
_face_y     :: Float
    , Face -> Float
_face_w     :: Float
    , Face -> Float
_face_h     :: Float
    , Face -> Float
_face_smile :: Float
    }
    deriving Int -> Face -> ShowS
[Face] -> ShowS
Face -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Face] -> ShowS
$cshowList :: [Face] -> ShowS
show :: Face -> String
$cshow :: Face -> String
showsPrec :: Int -> Face -> ShowS
$cshowsPrec :: Int -> Face -> ShowS
Show

makeLenses ''Face

data GPSReading = GPSReading
    { GPSReading -> Double
_gpsr_lat     :: Double
    , GPSReading -> Double
_gpsr_lon     :: Double
    , GPSReading -> Double
_gpsr_alt     :: Double
    , GPSReading -> Double
_gpsr_speed2d :: Double
    , GPSReading -> Double
_gpsr_speed3d :: Double
    , GPSReading -> UTCTime
_gpsr_time    :: UTCTime
    , GPSReading -> Double
_gpsr_dop     :: Double
    , GPSReading -> Int
_gpsr_fix     :: Int
    }
    deriving Int -> GPSReading -> ShowS
[GPSReading] -> ShowS
GPSReading -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GPSReading] -> ShowS
$cshowList :: [GPSReading] -> ShowS
show :: GPSReading -> String
$cshow :: GPSReading -> String
showsPrec :: Int -> GPSReading -> ShowS
$cshowsPrec :: Int -> GPSReading -> ShowS
Show

makeLenses ''GPSReading

data AudioLevel = AudioLevel
    { AudioLevel -> [Int]
_audio_rms  :: [Int]
    , AudioLevel -> [Int]
_audio_peak :: [Int]
    }
    deriving Int -> AudioLevel -> ShowS
[AudioLevel] -> ShowS
AudioLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioLevel] -> ShowS
$cshowList :: [AudioLevel] -> ShowS
show :: AudioLevel -> String
$cshow :: AudioLevel -> String
showsPrec :: Int -> AudioLevel -> ShowS
$cshowsPrec :: Int -> AudioLevel -> ShowS
Show

makeLenses ''AudioLevel

data Location = Snow
    | Urban
    | Indoor
    | Water
    | Vegetation
    | Beach
    deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Location]
$creadListPrec :: ReadPrec [Location]
readPrec :: ReadPrec Location
$creadPrec :: ReadPrec Location
readList :: ReadS [Location]
$creadList :: ReadS [Location]
readsPrec :: Int -> ReadS Location
$creadsPrec :: Int -> ReadS Location
Read, Location -> Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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 :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
Ord)

makePrisms ''Location

data TVals = TVUnknown [Value]
    | TVAccl Accelerometer
    | TVGyro Gyroscope
    | TVFaces [Face]
    | TVGPS5 [GPSReading]
    | TVGPS9 [GPSReading]
    | TVAudioLevel AudioLevel
    | TVScene [Map Location Float]
    deriving Int -> TVals -> ShowS
[TVals] -> ShowS
TVals -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TVals] -> ShowS
$cshowList :: [TVals] -> ShowS
show :: TVals -> String
$cshow :: TVals -> String
showsPrec :: Int -> TVals -> ShowS
$cshowsPrec :: Int -> TVals -> ShowS
Show

makePrisms ''TVals

data Telemetry = Telemetry
    { Telemetry -> Word64
_tele_stmp   :: Word64
    , Telemetry -> Int
_tele_tsmp   :: Int
    , Telemetry -> String
_tele_name   :: String
    , Telemetry -> TVals
_tele_values :: TVals
    }
    deriving Int -> Telemetry -> ShowS
[Telemetry] -> ShowS
Telemetry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Telemetry] -> ShowS
$cshowList :: [Telemetry] -> ShowS
show :: Telemetry -> String
$cshow :: Telemetry -> String
showsPrec :: Int -> Telemetry -> ShowS
$cshowsPrec :: Int -> Telemetry -> ShowS
Show

makeLenses ''Telemetry

data DEVC = DEVC
    { DEVC -> Int
_dev_id     :: Int
    , DEVC -> String
_dev_name   :: String
    , DEVC -> Map String Telemetry
_dev_telems :: Map String Telemetry
    }
    deriving Int -> DEVC -> ShowS
[DEVC] -> ShowS
DEVC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DEVC] -> ShowS
$cshowList :: [DEVC] -> ShowS
show :: DEVC -> String
$cshow :: DEVC -> String
showsPrec :: Int -> DEVC -> ShowS
$cshowsPrec :: Int -> DEVC -> ShowS
Show

makeLenses ''DEVC

-- | Get the best GPS readings from a DEVC.
-- This will attempt to return any TVGPS9 readings,
-- but will fall back to GPS5 readings if available.
gpsReadings :: Getter DEVC [GPSReading]
gpsReadings :: Getter DEVC [GPSReading]
gpsReadings = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Telemetry -> [GPSReading] -> [GPSReading]
f [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEVC -> Map String Telemetry
_dev_telems)
  where
    f :: Telemetry -> [GPSReading] -> [GPSReading]
f (Telemetry Word64
_ Int
_ String
_ (TVGPS9 [GPSReading]
v)) [GPSReading]
_  = [GPSReading]
v
    f (Telemetry Word64
_ Int
_ String
_ (TVGPS5 [GPSReading]
v)) [] = [GPSReading]
v
    f Telemetry
_ [GPSReading]
o                             = [GPSReading]
o

-- | Given a FourCC value (specifically, DEVC) and a list of Values,
-- produce a DEVC value.
mkDEVC :: FourCC -> [Value] -> Maybe DEVC
mkDEVC :: FourCC -> [Value] -> Maybe DEVC
mkDEVC FourCC
"DEVC" = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Value -> DEVC -> DEVC
addItem (Int -> String -> Map String Telemetry -> DEVC
DEVC Int
0 String
"" forall a. Monoid a => a
mempty)
  where
    addItem :: Value -> DEVC -> DEVC
addItem (GNested (FourCC
"DVID", [GUint32 [Word32
x]])) DEVC
o            = DEVC
o {_dev_id :: Int
_dev_id=forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x}
    addItem (GNested (FourCC
"DVNM", [GString String
x]))   DEVC
o            = DEVC
o {_dev_name :: String
_dev_name=String
x}
    addItem (GNested (FourCC
"STRM", [Value]
vals))          o :: DEVC
o@(DEVC{Int
String
Map String Telemetry
_dev_telems :: Map String Telemetry
_dev_name :: String
_dev_id :: Int
_dev_telems :: DEVC -> Map String Telemetry
_dev_name :: DEVC -> String
_dev_id :: DEVC -> Int
..}) = DEVC
o {_dev_telems :: Map String Telemetry
_dev_telems=Map String Telemetry -> [Value] -> Map String Telemetry
addTelem Map String Telemetry
_dev_telems [Value]
vals}
    addItem Value
_ DEVC
o                                            = DEVC
o

    addTelem :: Map String Telemetry -> [Value] -> Map String Telemetry
addTelem Map String Telemetry
m [Value]
vals = let t :: Telemetry
t =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Value -> Telemetry -> Telemetry
updTele (Word64 -> Int -> String -> TVals -> Telemetry
Telemetry Word64
0 Int
0 String
"" TVals
tvals) [Value]
vals in
                        forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Telemetry -> String
_tele_name Telemetry
t) Telemetry
t Map String Telemetry
m
      where
        updTele :: Value -> Telemetry -> Telemetry
updTele (GNested (FourCC
"STMP", [GUint64 [Word64
x]])) Telemetry
o = Telemetry
o {_tele_stmp :: Word64
_tele_stmp = Word64
x}
        updTele (GNested (FourCC
"TSMP", [GUint32 [Word32
x]])) Telemetry
o = Telemetry
o {_tele_tsmp :: Int
_tele_tsmp = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x}
        updTele (GNested (FourCC
"STNM", [GString String
x])) Telemetry
o   = Telemetry
o {_tele_name :: String
_tele_name = String
x}
        updTele Value
_ Telemetry
o                                 = Telemetry
o

        tvals :: TVals
        tvals :: TVals
tvals = (forall a. a -> Maybe a -> a
fromMaybe ([Value] -> TVals
TVUnknown [Value]
vals) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ [Value]
vals)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
(Eq a, IsString a) =>
a -> ([Value] -> Maybe TVals) -> [Value] -> Maybe TVals
findGrokker (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> [FourCC]
four forall a b. (a -> b) -> a -> b
$ [Value]
vals
          where
            four :: Value -> [FourCC]
four (GNested (FourCC
x, [Value]
_)) = [FourCC
x]
            four Value
_                = []

            findGrokker :: a -> ([Value] -> Maybe TVals) -> [Value] -> Maybe TVals
findGrokker a
"ACCL" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Accelerometer -> TVals
TVAccl forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe Accelerometer
grokAccl
            findGrokker a
"GYRO" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Gyroscope -> TVals
TVGyro forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe Gyroscope
grokGyro
            findGrokker a
"FACE" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Face] -> TVals
TVFaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe [Face]
grokFaces
            findGrokker a
"GPS5" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GPSReading] -> TVals
TVGPS5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe [GPSReading]
grokGPS5
            findGrokker a
"GPS9" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GPSReading] -> TVals
TVGPS9 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe [GPSReading]
grokGPS9
            findGrokker a
"AALP" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AudioLevel -> TVals
TVAudioLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe AudioLevel
grokAudioLevel
            findGrokker a
"SCEN" [Value] -> Maybe TVals
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map Location Float] -> TVals
TVScene forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe [Map Location Float]
grokScene
            findGrokker a
_ [Value] -> Maybe TVals
o      = [Value] -> Maybe TVals
o

mkDEVC FourCC
_ = forall a b. a -> b -> a
const forall a. Maybe a
Nothing

findVal :: FourCC -> [Value] -> Maybe [Value]
findVal :: FourCC -> [Value] -> Maybe [Value]
findVal FourCC
f = forall a. [a] -> Maybe a
exactlyOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. FourCC -> [Value] -> [[Value]]
findAll FourCC
f

findAll :: FourCC -> [Value] -> [[Value]]
findAll :: FourCC -> [Value] -> [[Value]]
findAll FourCC
f = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Value (FourCC, [Value])
_GNested forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(FourCC
d,[Value]
_) -> FourCC
d forall a. Eq a => a -> a -> Bool
== FourCC
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2)

exactlyOne :: [a] -> Maybe a
exactlyOne :: forall a. [a] -> Maybe a
exactlyOne [a
a] = forall a. a -> Maybe a
Just a
a
exactlyOne [a]
_   = forall a. Maybe a
Nothing

grokSens :: FourCC -> (Float -> [(Float, Float, Float)] -> a) -> [Value] -> Maybe a
grokSens :: forall a.
FourCC
-> (Float -> [(Float, Float, Float)] -> a) -> [Value] -> Maybe a
grokSens FourCC
sens Float -> [(Float, Float, Float)] -> a
cons [Value]
vals = do
  GFloat [Float]
templ <- forall a. [a] -> Maybe a
exactlyOne forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"TMPC" [Value]
vals
  GInt16 [Int16]
scall <- forall a. [a] -> Maybe a
exactlyOne forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"SCAL" [Value]
vals
  [[Int16]]
readings <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe [Int16]
ungint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FourCC -> [Value] -> Maybe [Value]
findVal FourCC
sens [Value]
vals

  Float
temp <- forall a. [a] -> Maybe a
exactlyOne [Float]
templ
  Float
scal <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
exactlyOne [Int16]
scall
  [(Float, Float, Float)]
scaled <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {c}. [c] -> Maybe (c, c, c)
trip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int16
x -> forall a b. (Real a, Fractional b) => a -> b
realToFrac Int16
x forall a. Fractional a => a -> a -> a
/ Float
scal)) [[Int16]]
readings

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Float -> [(Float, Float, Float)] -> a
cons Float
temp [(Float, Float, Float)]
scaled

  where ungint :: Value -> Maybe [Int16]
ungint (GInt16 [Int16]
xs) = forall a. a -> Maybe a
Just [Int16]
xs
        ungint Value
_           = forall a. Maybe a
Nothing
        trip :: [c] -> Maybe (c, c, c)
trip [c
a,c
b,c
c] = forall a. a -> Maybe a
Just (c
a,c
b,c
c)
        trip [c]
_       = forall a. Maybe a
Nothing

grokAccl :: [Value] -> Maybe Accelerometer
grokAccl :: [Value] -> Maybe Accelerometer
grokAccl = forall a.
FourCC
-> (Float -> [(Float, Float, Float)] -> a) -> [Value] -> Maybe a
grokSens FourCC
"ACCL" Float -> [(Float, Float, Float)] -> Accelerometer
Accelerometer

grokGyro :: [Value] -> Maybe Gyroscope
grokGyro :: [Value] -> Maybe Gyroscope
grokGyro = forall a.
FourCC
-> (Float -> [(Float, Float, Float)] -> a) -> [Value] -> Maybe a
grokSens FourCC
"GYRO" Float -> [(Float, Float, Float)] -> Gyroscope
Gyroscope

grokFaces :: [Value] -> Maybe [Face]
grokFaces :: [Value] -> Maybe [Face]
grokFaces = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Value] -> Maybe Face
mkFace forall b c a. (b -> c) -> (a -> b) -> a -> c
. FourCC -> [Value] -> [[Value]]
findAll FourCC
"FACE"
    where
      mkFace :: [Value] -> Maybe Face
      mkFace :: [Value] -> Maybe Face
mkFace [GComplex String
"Lffffff" [GUint32 [Word32
fid], GFloat [Float
x], GFloat [Float
y], GFloat [Float
w], GFloat [Float
h], Value
_, GFloat [Float
s]]] =
        forall a. a -> Maybe a
Just (Int -> Float -> Float -> Float -> Float -> Float -> Face
Face (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
fid) Float
x Float
y Float
w Float
h Float
s)
      mkFace [GComplex String
"Lffff" [GUint32 [Word32
fid], GFloat [Float
x], GFloat [Float
y], GFloat [Float
w], GFloat [Float
h]]] =
        forall a. a -> Maybe a
Just (Int -> Float -> Float -> Float -> Float -> Float -> Face
Face (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
fid) Float
x Float
y Float
w Float
h Float
0)
      mkFace [Value]
_ = forall a. Maybe a
Nothing

findSCAL :: Fractional b => [Value] -> Maybe [b]
findSCAL :: forall b. Fractional b => [Value] -> Maybe [b]
findSCAL [Value]
vals = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Int32
anInt) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"SCAL" [Value]
vals
  where
    anInt :: Value -> Maybe Int32
anInt (GInt32 [Int32
x]) = forall a. a -> Maybe a
Just Int32
x
    anInt Value
_            = forall a. Maybe a
Nothing

grokGPS5 :: [Value] -> Maybe [GPSReading]
grokGPS5 :: [Value] -> Maybe [GPSReading]
grokGPS5 [Value]
vals = do
  GUint16 [Word16
gpsp] <- forall a. [a] -> Maybe a
exactlyOne forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"GPSP" [Value]
vals
  GUint32 [Word32
gpsf] <- forall a. [a] -> Maybe a
exactlyOne forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"GPSF" [Value]
vals
  GTimestamp UTCTime
time <- forall a. [a] -> Maybe a
exactlyOne forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"GPSU" [Value]
vals
  [Double]
scals <- forall b. Fractional b => [Value] -> Maybe [b]
findSCAL [Value]
vals
  [Value]
g5s <- FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"GPS5" [Value]
vals
  let timestamps :: [UTCTime]
timestamps = [NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
n forall a. Num a => a -> a -> a
* NominalDiffTime
1forall a. Fractional a => a -> a -> a
/forall a b. (Real a, Fractional b) => a -> b
realToFrac @Int Int
10) UTCTime
time | NominalDiffTime
n <- [NominalDiffTime
0, NominalDiffTime
1 ..]]
  forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Double] -> Double -> Int -> (Value, UTCTime) -> Maybe [GPSReading]
readings [Double]
scals (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
gpsp) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
gpsf)) (forall a b. [a] -> [b] -> [(a, b)]
zip [Value]
g5s [UTCTime]
timestamps)

  where
    readings :: [Double] -> Double -> Int -> (Value, UTCTime) -> Maybe [GPSReading]
readings [Double]
scals Double
p Int
f (GInt32 [Int32]
ns, UTCTime
ts) = case forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
s Int32
n -> forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
n forall a. Fractional a => a -> a -> a
/ Double
s) [Double]
scals [Int32]
ns of
                                     [Double
_gpsr_lat,Double
_gpsr_lon,Double
_gpsr_alt,Double
_gpsr_speed2d,Double
_gpsr_speed3d]
                                       -> let _gpsr_time :: UTCTime
_gpsr_time=UTCTime
ts; _gpsr_dop :: Double
_gpsr_dop=Double
p; _gpsr_fix :: Int
_gpsr_fix=Int
f in forall a. a -> Maybe a
Just [GPSReading{Double
Int
UTCTime
_gpsr_fix :: Int
_gpsr_dop :: Double
_gpsr_time :: UTCTime
_gpsr_speed3d :: Double
_gpsr_speed2d :: Double
_gpsr_alt :: Double
_gpsr_lon :: Double
_gpsr_lat :: Double
_gpsr_fix :: Int
_gpsr_dop :: Double
_gpsr_time :: UTCTime
_gpsr_speed3d :: Double
_gpsr_speed2d :: Double
_gpsr_alt :: Double
_gpsr_lon :: Double
_gpsr_lat :: Double
..}]
                                     [Double]
_ -> forall a. Maybe a
Nothing
    readings [Double]
_ Double
_ Int
_ (Value, UTCTime)
_ = forall a. Maybe a
Nothing

grokGPS9 :: [Value] -> Maybe [GPSReading]
grokGPS9 :: [Value] -> Maybe [GPSReading]
grokGPS9 [Value]
vals = do
  [Double]
scals <- forall b. Fractional b => [Value] -> Maybe [b]
findSCAL [Value]
vals
  [Value]
gps9 <- FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"GPS9" [Value]
vals
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Double] -> Value -> Maybe GPSReading
oneGPS9 [Double]
scals) [Value]
gps9

  where
    baseDay :: Day
baseDay = Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
1 Int
1

    oneGPS9 :: [Double] -> Value -> Maybe GPSReading
    oneGPS9 :: [Double] -> Value -> Maybe GPSReading
oneGPS9 [Double
lats, Double
lons, Double
alts, Double
s2ds, Double
s3ds, Double
1, Double
1000, Double
dops, Double
1] (GComplex String
"lllllllSS" [GInt32 [Int32
lati], GInt32 [Int32
loni], GInt32 [Int32
alti], GInt32 [Int32
speed2di], GInt32 [Int32
speed3di], GInt32 [Int32
daysi], GInt32 [Int32
secsi], GUint16 [Word16
dopi], GUint16 [Word16
fixi]]) =
      forall a. a -> Maybe a
Just GPSReading{
        _gpsr_time :: UTCTime
_gpsr_time = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
daysi) Day
baseDay) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
secsi forall a. Fractional a => a -> a -> a
/ DiffTime
1000),
        _gpsr_lat :: Double
_gpsr_lat = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
lati forall a. Fractional a => a -> a -> a
/ Double
lats,
        _gpsr_lon :: Double
_gpsr_lon = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
loni forall a. Fractional a => a -> a -> a
/ Double
lons,
        _gpsr_alt :: Double
_gpsr_alt = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
alti forall a. Fractional a => a -> a -> a
/ Double
alts,
        _gpsr_speed2d :: Double
_gpsr_speed2d = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
speed2di forall a. Fractional a => a -> a -> a
/ Double
s2ds,
        _gpsr_speed3d :: Double
_gpsr_speed3d = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
speed3di forall a. Fractional a => a -> a -> a
/ Double
s3ds,
        _gpsr_dop :: Double
_gpsr_dop = forall a b. (Real a, Fractional b) => a -> b
realToFrac Word16
dopi forall a. Fractional a => a -> a -> a
/ Double
dops,
        _gpsr_fix :: Int
_gpsr_fix = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fixi
      }
    oneGPS9 [Double]
_ Value
_ = forall a. Maybe a
Nothing

grokAudioLevel :: [Value] -> Maybe AudioLevel
grokAudioLevel :: [Value] -> Maybe AudioLevel
grokAudioLevel [Value]
vals = do
  [[Int]
l1, [Int]
l2] <- forall a. [[a]] -> [[a]]
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. Num b => Value -> Maybe [b]
de forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FourCC -> [Value] -> Maybe [Value]
findVal FourCC
"AALP" [Value]
vals
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> AudioLevel
AudioLevel [Int]
l1 [Int]
l2

  where de :: Value -> Maybe [b]
de (GInt8 [Int8]
xs)      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int8]
xs
        de (GComplex String
_ [Value]
xs) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe [b]
de forall a b. (a -> b) -> a -> b
$ [Value]
xs
        de Value
_               = forall a. Maybe a
Nothing

grokScene :: [Value] -> Maybe [Map Location Float]
grokScene :: [Value] -> Maybe [Map Location Float]
grokScene = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Map Location Float
mkScene forall b c a. (b -> c) -> (a -> b) -> a -> c
. FourCC -> [Value] -> [[Value]]
findAll FourCC
"SCEN"
  where
    mkScene :: [Value] -> Map Location Float
    mkScene :: [Value] -> Map Location Float
mkScene = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe (Location, Float)
mkOne

    mkOne :: Value -> Maybe (Location, Float)
    mkOne :: Value -> Maybe (Location, Float)
mkOne (GComplex String
"Ff" [GFourCC FourCC
f, GFloat [Float
p]]) = FourCC -> Maybe Location
l FourCC
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Location
x -> forall a. a -> Maybe a
Just (Location
x, Float
p)
    mkOne Value
_                                       = forall a. Maybe a
Nothing

    l :: FourCC -> Maybe Location
    l :: FourCC -> Maybe Location
l FourCC
"SNOW" = forall a. a -> Maybe a
Just Location
Snow
    l FourCC
"URBA" = forall a. a -> Maybe a
Just Location
Urban
    l FourCC
"INDO" = forall a. a -> Maybe a
Just Location
Indoor
    l FourCC
"WATR" = forall a. a -> Maybe a
Just Location
Water
    l FourCC
"VEGE" = forall a. a -> Maybe a
Just Location
Vegetation
    l FourCC
"BEAC" = forall a. a -> Maybe a
Just Location
Beach
    l FourCC
_      = forall a. Maybe a
Nothing