{-
This module provides COCO format parser of object detection dataset.
Aeson is used for parsing JSON.
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeFamilies #-}

module RiskWeaver.Format.Coco where

import Codec.Picture.Metadata (Value (Double))
import Control.Monad (ap)
import Data.Aeson
import Data.ByteString.Lazy qualified as BS
import Data.List (maximumBy, sort, sortBy)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics

-- import Debug.Trace (trace)
-- myTrace :: Show a => String -> a -> a
-- myTrace s a = trace (s ++ ": " ++ show a) a

newtype ImageId = ImageId {ImageId -> Int
unImageId :: Int} deriving (Int -> ImageId -> ShowS
[ImageId] -> ShowS
ImageId -> FilePath
(Int -> ImageId -> ShowS)
-> (ImageId -> FilePath) -> ([ImageId] -> ShowS) -> Show ImageId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageId -> ShowS
showsPrec :: Int -> ImageId -> ShowS
$cshow :: ImageId -> FilePath
show :: ImageId -> FilePath
$cshowList :: [ImageId] -> ShowS
showList :: [ImageId] -> ShowS
Show, Eq ImageId
Eq ImageId =>
(ImageId -> ImageId -> Ordering)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> ImageId)
-> (ImageId -> ImageId -> ImageId)
-> Ord ImageId
ImageId -> ImageId -> Bool
ImageId -> ImageId -> Ordering
ImageId -> ImageId -> ImageId
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
$ccompare :: ImageId -> ImageId -> Ordering
compare :: ImageId -> ImageId -> Ordering
$c< :: ImageId -> ImageId -> Bool
< :: ImageId -> ImageId -> Bool
$c<= :: ImageId -> ImageId -> Bool
<= :: ImageId -> ImageId -> Bool
$c> :: ImageId -> ImageId -> Bool
> :: ImageId -> ImageId -> Bool
$c>= :: ImageId -> ImageId -> Bool
>= :: ImageId -> ImageId -> Bool
$cmax :: ImageId -> ImageId -> ImageId
max :: ImageId -> ImageId -> ImageId
$cmin :: ImageId -> ImageId -> ImageId
min :: ImageId -> ImageId -> ImageId
Ord, ImageId -> ImageId -> Bool
(ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool) -> Eq ImageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageId -> ImageId -> Bool
== :: ImageId -> ImageId -> Bool
$c/= :: ImageId -> ImageId -> Bool
/= :: ImageId -> ImageId -> Bool
Eq, (forall x. ImageId -> Rep ImageId x)
-> (forall x. Rep ImageId x -> ImageId) -> Generic ImageId
forall x. Rep ImageId x -> ImageId
forall x. ImageId -> Rep ImageId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImageId -> Rep ImageId x
from :: forall x. ImageId -> Rep ImageId x
$cto :: forall x. Rep ImageId x -> ImageId
to :: forall x. Rep ImageId x -> ImageId
Generic)

newtype CategoryId = CategoryId {CategoryId -> Int
unCategoryId :: Int} deriving (Int -> CategoryId -> ShowS
[CategoryId] -> ShowS
CategoryId -> FilePath
(Int -> CategoryId -> ShowS)
-> (CategoryId -> FilePath)
-> ([CategoryId] -> ShowS)
-> Show CategoryId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CategoryId -> ShowS
showsPrec :: Int -> CategoryId -> ShowS
$cshow :: CategoryId -> FilePath
show :: CategoryId -> FilePath
$cshowList :: [CategoryId] -> ShowS
showList :: [CategoryId] -> ShowS
Show, Eq CategoryId
Eq CategoryId =>
(CategoryId -> CategoryId -> Ordering)
-> (CategoryId -> CategoryId -> Bool)
-> (CategoryId -> CategoryId -> Bool)
-> (CategoryId -> CategoryId -> Bool)
-> (CategoryId -> CategoryId -> Bool)
-> (CategoryId -> CategoryId -> CategoryId)
-> (CategoryId -> CategoryId -> CategoryId)
-> Ord CategoryId
CategoryId -> CategoryId -> Bool
CategoryId -> CategoryId -> Ordering
CategoryId -> CategoryId -> CategoryId
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
$ccompare :: CategoryId -> CategoryId -> Ordering
compare :: CategoryId -> CategoryId -> Ordering
$c< :: CategoryId -> CategoryId -> Bool
< :: CategoryId -> CategoryId -> Bool
$c<= :: CategoryId -> CategoryId -> Bool
<= :: CategoryId -> CategoryId -> Bool
$c> :: CategoryId -> CategoryId -> Bool
> :: CategoryId -> CategoryId -> Bool
$c>= :: CategoryId -> CategoryId -> Bool
>= :: CategoryId -> CategoryId -> Bool
$cmax :: CategoryId -> CategoryId -> CategoryId
max :: CategoryId -> CategoryId -> CategoryId
$cmin :: CategoryId -> CategoryId -> CategoryId
min :: CategoryId -> CategoryId -> CategoryId
Ord, CategoryId -> CategoryId -> Bool
(CategoryId -> CategoryId -> Bool)
-> (CategoryId -> CategoryId -> Bool) -> Eq CategoryId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CategoryId -> CategoryId -> Bool
== :: CategoryId -> CategoryId -> Bool
$c/= :: CategoryId -> CategoryId -> Bool
/= :: CategoryId -> CategoryId -> Bool
Eq, (forall x. CategoryId -> Rep CategoryId x)
-> (forall x. Rep CategoryId x -> CategoryId) -> Generic CategoryId
forall x. Rep CategoryId x -> CategoryId
forall x. CategoryId -> Rep CategoryId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CategoryId -> Rep CategoryId x
from :: forall x. CategoryId -> Rep CategoryId x
$cto :: forall x. Rep CategoryId x -> CategoryId
to :: forall x. Rep CategoryId x -> CategoryId
Generic)

newtype Score = Score {Score -> Double
unScore :: Double} deriving (Int -> Score -> ShowS
[Score] -> ShowS
Score -> FilePath
(Int -> Score -> ShowS)
-> (Score -> FilePath) -> ([Score] -> ShowS) -> Show Score
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Score -> ShowS
showsPrec :: Int -> Score -> ShowS
$cshow :: Score -> FilePath
show :: Score -> FilePath
$cshowList :: [Score] -> ShowS
showList :: [Score] -> ShowS
Show, Score -> Score -> Bool
(Score -> Score -> Bool) -> (Score -> Score -> Bool) -> Eq Score
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Score -> Score -> Bool
== :: Score -> Score -> Bool
$c/= :: Score -> Score -> Bool
/= :: Score -> Score -> Bool
Eq, Eq Score
Eq Score =>
(Score -> Score -> Ordering)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Bool)
-> (Score -> Score -> Score)
-> (Score -> Score -> Score)
-> Ord Score
Score -> Score -> Bool
Score -> Score -> Ordering
Score -> Score -> Score
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
$ccompare :: Score -> Score -> Ordering
compare :: Score -> Score -> Ordering
$c< :: Score -> Score -> Bool
< :: Score -> Score -> Bool
$c<= :: Score -> Score -> Bool
<= :: Score -> Score -> Bool
$c> :: Score -> Score -> Bool
> :: Score -> Score -> Bool
$c>= :: Score -> Score -> Bool
>= :: Score -> Score -> Bool
$cmax :: Score -> Score -> Score
max :: Score -> Score -> Score
$cmin :: Score -> Score -> Score
min :: Score -> Score -> Score
Ord, Integer -> Score
Score -> Score
Score -> Score -> Score
(Score -> Score -> Score)
-> (Score -> Score -> Score)
-> (Score -> Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Integer -> Score)
-> Num Score
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Score -> Score -> Score
+ :: Score -> Score -> Score
$c- :: Score -> Score -> Score
- :: Score -> Score -> Score
$c* :: Score -> Score -> Score
* :: Score -> Score -> Score
$cnegate :: Score -> Score
negate :: Score -> Score
$cabs :: Score -> Score
abs :: Score -> Score
$csignum :: Score -> Score
signum :: Score -> Score
$cfromInteger :: Integer -> Score
fromInteger :: Integer -> Score
Num, Num Score
Num Score =>
(Score -> Score -> Score)
-> (Score -> Score) -> (Rational -> Score) -> Fractional Score
Rational -> Score
Score -> Score
Score -> Score -> Score
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Score -> Score -> Score
/ :: Score -> Score -> Score
$crecip :: Score -> Score
recip :: Score -> Score
$cfromRational :: Rational -> Score
fromRational :: Rational -> Score
Fractional, Fractional Score
Score
Fractional Score =>
Score
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score -> Score)
-> (Score -> Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> (Score -> Score)
-> Floating Score
Score -> Score
Score -> Score -> Score
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Score
pi :: Score
$cexp :: Score -> Score
exp :: Score -> Score
$clog :: Score -> Score
log :: Score -> Score
$csqrt :: Score -> Score
sqrt :: Score -> Score
$c** :: Score -> Score -> Score
** :: Score -> Score -> Score
$clogBase :: Score -> Score -> Score
logBase :: Score -> Score -> Score
$csin :: Score -> Score
sin :: Score -> Score
$ccos :: Score -> Score
cos :: Score -> Score
$ctan :: Score -> Score
tan :: Score -> Score
$casin :: Score -> Score
asin :: Score -> Score
$cacos :: Score -> Score
acos :: Score -> Score
$catan :: Score -> Score
atan :: Score -> Score
$csinh :: Score -> Score
sinh :: Score -> Score
$ccosh :: Score -> Score
cosh :: Score -> Score
$ctanh :: Score -> Score
tanh :: Score -> Score
$casinh :: Score -> Score
asinh :: Score -> Score
$cacosh :: Score -> Score
acosh :: Score -> Score
$catanh :: Score -> Score
atanh :: Score -> Score
$clog1p :: Score -> Score
log1p :: Score -> Score
$cexpm1 :: Score -> Score
expm1 :: Score -> Score
$clog1pexp :: Score -> Score
log1pexp :: Score -> Score
$clog1mexp :: Score -> Score
log1mexp :: Score -> Score
Floating, Num Score
Ord Score
(Num Score, Ord Score) => (Score -> Rational) -> Real Score
Score -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Score -> Rational
toRational :: Score -> Rational
Real, Fractional Score
Real Score
(Real Score, Fractional Score) =>
(forall b. Integral b => Score -> (b, Score))
-> (forall b. Integral b => Score -> b)
-> (forall b. Integral b => Score -> b)
-> (forall b. Integral b => Score -> b)
-> (forall b. Integral b => Score -> b)
-> RealFrac Score
forall b. Integral b => Score -> b
forall b. Integral b => Score -> (b, Score)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Score -> (b, Score)
properFraction :: forall b. Integral b => Score -> (b, Score)
$ctruncate :: forall b. Integral b => Score -> b
truncate :: forall b. Integral b => Score -> b
$cround :: forall b. Integral b => Score -> b
round :: forall b. Integral b => Score -> b
$cceiling :: forall b. Integral b => Score -> b
ceiling :: forall b. Integral b => Score -> b
$cfloor :: forall b. Integral b => Score -> b
floor :: forall b. Integral b => Score -> b
RealFrac, Floating Score
RealFrac Score
(RealFrac Score, Floating Score) =>
(Score -> Integer)
-> (Score -> Int)
-> (Score -> (Int, Int))
-> (Score -> (Integer, Int))
-> (Integer -> Int -> Score)
-> (Score -> Int)
-> (Score -> Score)
-> (Int -> Score -> Score)
-> (Score -> Bool)
-> (Score -> Bool)
-> (Score -> Bool)
-> (Score -> Bool)
-> (Score -> Bool)
-> (Score -> Score -> Score)
-> RealFloat Score
Int -> Score -> Score
Integer -> Int -> Score
Score -> Bool
Score -> Int
Score -> Integer
Score -> (Int, Int)
Score -> (Integer, Int)
Score -> Score
Score -> Score -> Score
forall a.
(RealFrac a, Floating a) =>
(a -> Integer)
-> (a -> Int)
-> (a -> (Int, Int))
-> (a -> (Integer, Int))
-> (Integer -> Int -> a)
-> (a -> Int)
-> (a -> a)
-> (Int -> a -> a)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> a -> a)
-> RealFloat a
$cfloatRadix :: Score -> Integer
floatRadix :: Score -> Integer
$cfloatDigits :: Score -> Int
floatDigits :: Score -> Int
$cfloatRange :: Score -> (Int, Int)
floatRange :: Score -> (Int, Int)
$cdecodeFloat :: Score -> (Integer, Int)
decodeFloat :: Score -> (Integer, Int)
$cencodeFloat :: Integer -> Int -> Score
encodeFloat :: Integer -> Int -> Score
$cexponent :: Score -> Int
exponent :: Score -> Int
$csignificand :: Score -> Score
significand :: Score -> Score
$cscaleFloat :: Int -> Score -> Score
scaleFloat :: Int -> Score -> Score
$cisNaN :: Score -> Bool
isNaN :: Score -> Bool
$cisInfinite :: Score -> Bool
isInfinite :: Score -> Bool
$cisDenormalized :: Score -> Bool
isDenormalized :: Score -> Bool
$cisNegativeZero :: Score -> Bool
isNegativeZero :: Score -> Bool
$cisIEEE :: Score -> Bool
isIEEE :: Score -> Bool
$catan2 :: Score -> Score -> Score
atan2 :: Score -> Score -> Score
RealFloat, (forall x. Score -> Rep Score x)
-> (forall x. Rep Score x -> Score) -> Generic Score
forall x. Rep Score x -> Score
forall x. Score -> Rep Score x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Score -> Rep Score x
from :: forall x. Score -> Rep Score x
$cto :: forall x. Rep Score x -> Score
to :: forall x. Rep Score x -> Score
Generic)

instance FromJSON ImageId where
  parseJSON :: Value -> Parser ImageId
parseJSON = FilePath
-> (Scientific -> Parser ImageId) -> Value -> Parser ImageId
forall a. FilePath -> (Scientific -> Parser a) -> Value -> Parser a
withScientific FilePath
"image_id" ((Scientific -> Parser ImageId) -> Value -> Parser ImageId)
-> (Scientific -> Parser ImageId) -> Value -> Parser ImageId
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> do
    ImageId -> Parser ImageId
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageId -> Parser ImageId) -> ImageId -> Parser ImageId
forall a b. (a -> b) -> a -> b
$ Int -> ImageId
ImageId (Int -> ImageId) -> Int -> ImageId
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n

instance ToJSON ImageId where
  toJSON :: ImageId -> Value
toJSON (ImageId Int
n) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
n

instance FromJSON CategoryId where
  parseJSON :: Value -> Parser CategoryId
parseJSON = FilePath
-> (Scientific -> Parser CategoryId) -> Value -> Parser CategoryId
forall a. FilePath -> (Scientific -> Parser a) -> Value -> Parser a
withScientific FilePath
"category_id" ((Scientific -> Parser CategoryId) -> Value -> Parser CategoryId)
-> (Scientific -> Parser CategoryId) -> Value -> Parser CategoryId
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> do
    CategoryId -> Parser CategoryId
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryId -> Parser CategoryId)
-> CategoryId -> Parser CategoryId
forall a b. (a -> b) -> a -> b
$ Int -> CategoryId
CategoryId (Int -> CategoryId) -> Int -> CategoryId
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n

instance ToJSON CategoryId where
  toJSON :: CategoryId -> Value
toJSON (CategoryId Int
n) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
n

instance FromJSON Score where
  parseJSON :: Value -> Parser Score
parseJSON = FilePath -> (Scientific -> Parser Score) -> Value -> Parser Score
forall a. FilePath -> (Scientific -> Parser a) -> Value -> Parser a
withScientific FilePath
"score" ((Scientific -> Parser Score) -> Value -> Parser Score)
-> (Scientific -> Parser Score) -> Value -> Parser Score
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> do
    Score -> Parser Score
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Score -> Parser Score) -> Score -> Parser Score
forall a b. (a -> b) -> a -> b
$ Double -> Score
Score (Double -> Score) -> Double -> Score
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
n

instance ToJSON Score where
  toJSON :: Score -> Value
toJSON (Score Double
n) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
n

data CocoInfo = CocoInfo
  { CocoInfo -> Int
cocoInfoYear :: Int,
    CocoInfo -> Text
cocoInfoVersion :: Text,
    CocoInfo -> Text
cocoInfoDescription :: Text,
    CocoInfo -> Text
cocoInfoContributor :: Text,
    CocoInfo -> Text
cocoInfoUrl :: Text,
    CocoInfo -> Text
cocoInfoDateCreated :: Text
  }
  deriving (Int -> CocoInfo -> ShowS
[CocoInfo] -> ShowS
CocoInfo -> FilePath
(Int -> CocoInfo -> ShowS)
-> (CocoInfo -> FilePath) -> ([CocoInfo] -> ShowS) -> Show CocoInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoInfo -> ShowS
showsPrec :: Int -> CocoInfo -> ShowS
$cshow :: CocoInfo -> FilePath
show :: CocoInfo -> FilePath
$cshowList :: [CocoInfo] -> ShowS
showList :: [CocoInfo] -> ShowS
Show, CocoInfo -> CocoInfo -> Bool
(CocoInfo -> CocoInfo -> Bool)
-> (CocoInfo -> CocoInfo -> Bool) -> Eq CocoInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoInfo -> CocoInfo -> Bool
== :: CocoInfo -> CocoInfo -> Bool
$c/= :: CocoInfo -> CocoInfo -> Bool
/= :: CocoInfo -> CocoInfo -> Bool
Eq, (forall x. CocoInfo -> Rep CocoInfo x)
-> (forall x. Rep CocoInfo x -> CocoInfo) -> Generic CocoInfo
forall x. Rep CocoInfo x -> CocoInfo
forall x. CocoInfo -> Rep CocoInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoInfo -> Rep CocoInfo x
from :: forall x. CocoInfo -> Rep CocoInfo x
$cto :: forall x. Rep CocoInfo x -> CocoInfo
to :: forall x. Rep CocoInfo x -> CocoInfo
Generic)

instance FromJSON CocoInfo where
  parseJSON :: Value -> Parser CocoInfo
parseJSON = FilePath -> (Object -> Parser CocoInfo) -> Value -> Parser CocoInfo
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"info" ((Object -> Parser CocoInfo) -> Value -> Parser CocoInfo)
-> (Object -> Parser CocoInfo) -> Value -> Parser CocoInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
cocoInfoYear <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"year"
    Text
cocoInfoVersion <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    Text
cocoInfoDescription <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Text
cocoInfoContributor <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contributor"
    Text
cocoInfoUrl <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
    Text
cocoInfoDateCreated <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"date_created"
    CocoInfo -> Parser CocoInfo
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CocoInfo {Int
Text
cocoInfoYear :: Int
cocoInfoVersion :: Text
cocoInfoDescription :: Text
cocoInfoContributor :: Text
cocoInfoUrl :: Text
cocoInfoDateCreated :: Text
cocoInfoYear :: Int
cocoInfoVersion :: Text
cocoInfoDescription :: Text
cocoInfoContributor :: Text
cocoInfoUrl :: Text
cocoInfoDateCreated :: Text
..}

instance ToJSON CocoInfo where
  toJSON :: CocoInfo -> Value
toJSON CocoInfo {Int
Text
cocoInfoYear :: CocoInfo -> Int
cocoInfoVersion :: CocoInfo -> Text
cocoInfoDescription :: CocoInfo -> Text
cocoInfoContributor :: CocoInfo -> Text
cocoInfoUrl :: CocoInfo -> Text
cocoInfoDateCreated :: CocoInfo -> Text
cocoInfoYear :: Int
cocoInfoVersion :: Text
cocoInfoDescription :: Text
cocoInfoContributor :: Text
cocoInfoUrl :: Text
cocoInfoDateCreated :: Text
..} =
    [Pair] -> Value
object
      [ Key
"year" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
cocoInfoYear,
        Key
"version" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoInfoVersion,
        Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoInfoDescription,
        Key
"contributor" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoInfoContributor,
        Key
"url" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoInfoUrl,
        Key
"date_created" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoInfoDateCreated
      ]

data CocoLicense = CocoLicense
  { CocoLicense -> Int
cocoLicenseId :: Int,
    CocoLicense -> Text
cocoLicenseName :: Text,
    CocoLicense -> Text
cocoLicenseUrl :: Text
  }
  deriving (Int -> CocoLicense -> ShowS
[CocoLicense] -> ShowS
CocoLicense -> FilePath
(Int -> CocoLicense -> ShowS)
-> (CocoLicense -> FilePath)
-> ([CocoLicense] -> ShowS)
-> Show CocoLicense
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoLicense -> ShowS
showsPrec :: Int -> CocoLicense -> ShowS
$cshow :: CocoLicense -> FilePath
show :: CocoLicense -> FilePath
$cshowList :: [CocoLicense] -> ShowS
showList :: [CocoLicense] -> ShowS
Show, CocoLicense -> CocoLicense -> Bool
(CocoLicense -> CocoLicense -> Bool)
-> (CocoLicense -> CocoLicense -> Bool) -> Eq CocoLicense
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoLicense -> CocoLicense -> Bool
== :: CocoLicense -> CocoLicense -> Bool
$c/= :: CocoLicense -> CocoLicense -> Bool
/= :: CocoLicense -> CocoLicense -> Bool
Eq, (forall x. CocoLicense -> Rep CocoLicense x)
-> (forall x. Rep CocoLicense x -> CocoLicense)
-> Generic CocoLicense
forall x. Rep CocoLicense x -> CocoLicense
forall x. CocoLicense -> Rep CocoLicense x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoLicense -> Rep CocoLicense x
from :: forall x. CocoLicense -> Rep CocoLicense x
$cto :: forall x. Rep CocoLicense x -> CocoLicense
to :: forall x. Rep CocoLicense x -> CocoLicense
Generic)

instance FromJSON CocoLicense where
  parseJSON :: Value -> Parser CocoLicense
parseJSON = FilePath
-> (Object -> Parser CocoLicense) -> Value -> Parser CocoLicense
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"license" ((Object -> Parser CocoLicense) -> Value -> Parser CocoLicense)
-> (Object -> Parser CocoLicense) -> Value -> Parser CocoLicense
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
cocoLicenseId <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
cocoLicenseName <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Text
cocoLicenseUrl <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
    CocoLicense -> Parser CocoLicense
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CocoLicense {Int
Text
cocoLicenseId :: Int
cocoLicenseName :: Text
cocoLicenseUrl :: Text
cocoLicenseId :: Int
cocoLicenseName :: Text
cocoLicenseUrl :: Text
..}

instance ToJSON CocoLicense where
  toJSON :: CocoLicense -> Value
toJSON CocoLicense {Int
Text
cocoLicenseId :: CocoLicense -> Int
cocoLicenseName :: CocoLicense -> Text
cocoLicenseUrl :: CocoLicense -> Text
cocoLicenseId :: Int
cocoLicenseName :: Text
cocoLicenseUrl :: Text
..} =
    [Pair] -> Value
object
      [ Key
"id" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
cocoLicenseId,
        Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoLicenseName,
        Key
"url" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoLicenseUrl
      ]

data CocoImage = CocoImage
  { CocoImage -> ImageId
cocoImageId :: ImageId,
    CocoImage -> Int
cocoImageWidth :: Int,
    CocoImage -> Int
cocoImageHeight :: Int,
    CocoImage -> Text
cocoImageFileName :: Text,
    CocoImage -> Maybe Int
cocoImageLicense :: Maybe Int,
    CocoImage -> Maybe Text
cocoImageDateCoco :: Maybe Text
  }
  deriving (Int -> CocoImage -> ShowS
[CocoImage] -> ShowS
CocoImage -> FilePath
(Int -> CocoImage -> ShowS)
-> (CocoImage -> FilePath)
-> ([CocoImage] -> ShowS)
-> Show CocoImage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoImage -> ShowS
showsPrec :: Int -> CocoImage -> ShowS
$cshow :: CocoImage -> FilePath
show :: CocoImage -> FilePath
$cshowList :: [CocoImage] -> ShowS
showList :: [CocoImage] -> ShowS
Show, CocoImage -> CocoImage -> Bool
(CocoImage -> CocoImage -> Bool)
-> (CocoImage -> CocoImage -> Bool) -> Eq CocoImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoImage -> CocoImage -> Bool
== :: CocoImage -> CocoImage -> Bool
$c/= :: CocoImage -> CocoImage -> Bool
/= :: CocoImage -> CocoImage -> Bool
Eq, (forall x. CocoImage -> Rep CocoImage x)
-> (forall x. Rep CocoImage x -> CocoImage) -> Generic CocoImage
forall x. Rep CocoImage x -> CocoImage
forall x. CocoImage -> Rep CocoImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoImage -> Rep CocoImage x
from :: forall x. CocoImage -> Rep CocoImage x
$cto :: forall x. Rep CocoImage x -> CocoImage
to :: forall x. Rep CocoImage x -> CocoImage
Generic)

instance FromJSON CocoImage where
  parseJSON :: Value -> Parser CocoImage
parseJSON = FilePath
-> (Object -> Parser CocoImage) -> Value -> Parser CocoImage
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"image" ((Object -> Parser CocoImage) -> Value -> Parser CocoImage)
-> (Object -> Parser CocoImage) -> Value -> Parser CocoImage
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ImageId
cocoImageId <- Object
o Object -> Key -> Parser ImageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Int
cocoImageWidth <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
    Int
cocoImageHeight <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
    Text
cocoImageFileName <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"file_name"
    Maybe Int
cocoImageLicense <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"license"
    Maybe Text
cocoImageDateCoco <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"date_captured"
    CocoImage -> Parser CocoImage
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CocoImage {Int
Maybe Int
Maybe Text
Text
ImageId
cocoImageId :: ImageId
cocoImageWidth :: Int
cocoImageHeight :: Int
cocoImageFileName :: Text
cocoImageLicense :: Maybe Int
cocoImageDateCoco :: Maybe Text
cocoImageId :: ImageId
cocoImageWidth :: Int
cocoImageHeight :: Int
cocoImageFileName :: Text
cocoImageLicense :: Maybe Int
cocoImageDateCoco :: Maybe Text
..}

instance ToJSON CocoImage where
  toJSON :: CocoImage -> Value
toJSON CocoImage {Int
Maybe Int
Maybe Text
Text
ImageId
cocoImageId :: CocoImage -> ImageId
cocoImageWidth :: CocoImage -> Int
cocoImageHeight :: CocoImage -> Int
cocoImageFileName :: CocoImage -> Text
cocoImageLicense :: CocoImage -> Maybe Int
cocoImageDateCoco :: CocoImage -> Maybe Text
cocoImageId :: ImageId
cocoImageWidth :: Int
cocoImageHeight :: Int
cocoImageFileName :: Text
cocoImageLicense :: Maybe Int
cocoImageDateCoco :: Maybe Text
..} =
    [Pair] -> Value
object
      [ Key
"id" Key -> ImageId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageId
cocoImageId,
        Key
"width" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
cocoImageWidth,
        Key
"height" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
cocoImageHeight,
        Key
"file_name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoImageFileName,
        Key
"license" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
cocoImageLicense,
        Key
"date_captured" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
cocoImageDateCoco
      ]

newtype CoCoBoundingBox
  = CoCoBoundingBox (Double, Double, Double, Double)
  deriving (Int -> CoCoBoundingBox -> ShowS
[CoCoBoundingBox] -> ShowS
CoCoBoundingBox -> FilePath
(Int -> CoCoBoundingBox -> ShowS)
-> (CoCoBoundingBox -> FilePath)
-> ([CoCoBoundingBox] -> ShowS)
-> Show CoCoBoundingBox
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CoCoBoundingBox -> ShowS
showsPrec :: Int -> CoCoBoundingBox -> ShowS
$cshow :: CoCoBoundingBox -> FilePath
show :: CoCoBoundingBox -> FilePath
$cshowList :: [CoCoBoundingBox] -> ShowS
showList :: [CoCoBoundingBox] -> ShowS
Show, CoCoBoundingBox -> CoCoBoundingBox -> Bool
(CoCoBoundingBox -> CoCoBoundingBox -> Bool)
-> (CoCoBoundingBox -> CoCoBoundingBox -> Bool)
-> Eq CoCoBoundingBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CoCoBoundingBox -> CoCoBoundingBox -> Bool
== :: CoCoBoundingBox -> CoCoBoundingBox -> Bool
$c/= :: CoCoBoundingBox -> CoCoBoundingBox -> Bool
/= :: CoCoBoundingBox -> CoCoBoundingBox -> Bool
Eq, (forall x. CoCoBoundingBox -> Rep CoCoBoundingBox x)
-> (forall x. Rep CoCoBoundingBox x -> CoCoBoundingBox)
-> Generic CoCoBoundingBox
forall x. Rep CoCoBoundingBox x -> CoCoBoundingBox
forall x. CoCoBoundingBox -> Rep CoCoBoundingBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CoCoBoundingBox -> Rep CoCoBoundingBox x
from :: forall x. CoCoBoundingBox -> Rep CoCoBoundingBox x
$cto :: forall x. Rep CoCoBoundingBox x -> CoCoBoundingBox
to :: forall x. Rep CoCoBoundingBox x -> CoCoBoundingBox
Generic)

-- (x, y, width, height)

data CocoAnnotation = CocoAnnotation
  { CocoAnnotation -> Int
cocoAnnotationId :: Int,
    CocoAnnotation -> ImageId
cocoAnnotationImageId :: ImageId,
    CocoAnnotation -> CategoryId
cocoAnnotationCategory :: CategoryId,
    CocoAnnotation -> Maybe [[Double]]
cocoAnnotationSegment :: Maybe [[Double]], -- [[x1, y1, x2, y2, ...]]
    CocoAnnotation -> Double
cocoAnnotationArea :: Double,
    CocoAnnotation -> CoCoBoundingBox
cocoAnnotationBbox :: CoCoBoundingBox,
    CocoAnnotation -> Maybe Int
cocoAnnotationIsCrowd :: Maybe Int
  }
  deriving (Int -> CocoAnnotation -> ShowS
[CocoAnnotation] -> ShowS
CocoAnnotation -> FilePath
(Int -> CocoAnnotation -> ShowS)
-> (CocoAnnotation -> FilePath)
-> ([CocoAnnotation] -> ShowS)
-> Show CocoAnnotation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoAnnotation -> ShowS
showsPrec :: Int -> CocoAnnotation -> ShowS
$cshow :: CocoAnnotation -> FilePath
show :: CocoAnnotation -> FilePath
$cshowList :: [CocoAnnotation] -> ShowS
showList :: [CocoAnnotation] -> ShowS
Show, CocoAnnotation -> CocoAnnotation -> Bool
(CocoAnnotation -> CocoAnnotation -> Bool)
-> (CocoAnnotation -> CocoAnnotation -> Bool) -> Eq CocoAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoAnnotation -> CocoAnnotation -> Bool
== :: CocoAnnotation -> CocoAnnotation -> Bool
$c/= :: CocoAnnotation -> CocoAnnotation -> Bool
/= :: CocoAnnotation -> CocoAnnotation -> Bool
Eq, (forall x. CocoAnnotation -> Rep CocoAnnotation x)
-> (forall x. Rep CocoAnnotation x -> CocoAnnotation)
-> Generic CocoAnnotation
forall x. Rep CocoAnnotation x -> CocoAnnotation
forall x. CocoAnnotation -> Rep CocoAnnotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoAnnotation -> Rep CocoAnnotation x
from :: forall x. CocoAnnotation -> Rep CocoAnnotation x
$cto :: forall x. Rep CocoAnnotation x -> CocoAnnotation
to :: forall x. Rep CocoAnnotation x -> CocoAnnotation
Generic)

instance FromJSON CocoAnnotation where
  parseJSON :: Value -> Parser CocoAnnotation
parseJSON = FilePath
-> (Object -> Parser CocoAnnotation)
-> Value
-> Parser CocoAnnotation
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"annotation" ((Object -> Parser CocoAnnotation)
 -> Value -> Parser CocoAnnotation)
-> (Object -> Parser CocoAnnotation)
-> Value
-> Parser CocoAnnotation
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
cocoAnnotationId <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    ImageId
cocoAnnotationImageId <- Object
o Object -> Key -> Parser ImageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image_id"
    CategoryId
cocoAnnotationCategory <- Object
o Object -> Key -> Parser CategoryId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"category_id"
    Maybe [[Double]]
cocoAnnotationSegment <- Object
o Object -> Key -> Parser (Maybe [[Double]])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"segmentation"
    Double
cocoAnnotationArea <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"area"
    CoCoBoundingBox
cocoAnnotationBbox <- ([Double] -> CoCoBoundingBox)
-> Parser [Double] -> Parser CoCoBoundingBox
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Double
x, Double
y, Double
w, Double
h] -> (Double, Double, Double, Double) -> CoCoBoundingBox
CoCoBoundingBox (Double
x, Double
y, Double
w, Double
h)) (Parser [Double] -> Parser CoCoBoundingBox)
-> Parser [Double] -> Parser CoCoBoundingBox
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Key -> Parser [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bbox"
    Maybe Int
cocoAnnotationIsCrowd <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"iscrowd"
    CocoAnnotation -> Parser CocoAnnotation
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CocoAnnotation {Double
Int
Maybe Int
Maybe [[Double]]
CoCoBoundingBox
CategoryId
ImageId
cocoAnnotationId :: Int
cocoAnnotationImageId :: ImageId
cocoAnnotationCategory :: CategoryId
cocoAnnotationSegment :: Maybe [[Double]]
cocoAnnotationArea :: Double
cocoAnnotationBbox :: CoCoBoundingBox
cocoAnnotationIsCrowd :: Maybe Int
cocoAnnotationId :: Int
cocoAnnotationImageId :: ImageId
cocoAnnotationCategory :: CategoryId
cocoAnnotationSegment :: Maybe [[Double]]
cocoAnnotationArea :: Double
cocoAnnotationBbox :: CoCoBoundingBox
cocoAnnotationIsCrowd :: Maybe Int
..}

instance ToJSON CocoAnnotation where
  toJSON :: CocoAnnotation -> Value
toJSON CocoAnnotation {Double
Int
Maybe Int
Maybe [[Double]]
CoCoBoundingBox
CategoryId
ImageId
cocoAnnotationId :: CocoAnnotation -> Int
cocoAnnotationImageId :: CocoAnnotation -> ImageId
cocoAnnotationCategory :: CocoAnnotation -> CategoryId
cocoAnnotationSegment :: CocoAnnotation -> Maybe [[Double]]
cocoAnnotationArea :: CocoAnnotation -> Double
cocoAnnotationBbox :: CocoAnnotation -> CoCoBoundingBox
cocoAnnotationIsCrowd :: CocoAnnotation -> Maybe Int
cocoAnnotationId :: Int
cocoAnnotationImageId :: ImageId
cocoAnnotationCategory :: CategoryId
cocoAnnotationSegment :: Maybe [[Double]]
cocoAnnotationArea :: Double
cocoAnnotationBbox :: CoCoBoundingBox
cocoAnnotationIsCrowd :: Maybe Int
..} =
    [Pair] -> Value
object
      [ Key
"id" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
cocoAnnotationId,
        Key
"image_id" Key -> ImageId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageId
cocoAnnotationImageId,
        Key
"category_id" Key -> CategoryId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CategoryId
cocoAnnotationCategory,
        Key
"segmentation" Key -> Maybe [[Double]] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe [[Double]]
cocoAnnotationSegment,
        Key
"area" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
cocoAnnotationArea,
        Key
"bbox" Key -> [Double] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case CoCoBoundingBox
cocoAnnotationBbox of CoCoBoundingBox (Double
x, Double
y, Double
w, Double
h) -> [Double
x, Double
y, Double
w, Double
h],
        Key
"iscrowd" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
cocoAnnotationIsCrowd
      ]

data CocoCategory = CocoCategory
  { CocoCategory -> CategoryId
cocoCategoryId :: CategoryId,
    CocoCategory -> Text
cocoCategoryName :: Text,
    CocoCategory -> Text
cocoCategorySupercategory :: Text
  }
  deriving (Int -> CocoCategory -> ShowS
[CocoCategory] -> ShowS
CocoCategory -> FilePath
(Int -> CocoCategory -> ShowS)
-> (CocoCategory -> FilePath)
-> ([CocoCategory] -> ShowS)
-> Show CocoCategory
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoCategory -> ShowS
showsPrec :: Int -> CocoCategory -> ShowS
$cshow :: CocoCategory -> FilePath
show :: CocoCategory -> FilePath
$cshowList :: [CocoCategory] -> ShowS
showList :: [CocoCategory] -> ShowS
Show, CocoCategory -> CocoCategory -> Bool
(CocoCategory -> CocoCategory -> Bool)
-> (CocoCategory -> CocoCategory -> Bool) -> Eq CocoCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoCategory -> CocoCategory -> Bool
== :: CocoCategory -> CocoCategory -> Bool
$c/= :: CocoCategory -> CocoCategory -> Bool
/= :: CocoCategory -> CocoCategory -> Bool
Eq, (forall x. CocoCategory -> Rep CocoCategory x)
-> (forall x. Rep CocoCategory x -> CocoCategory)
-> Generic CocoCategory
forall x. Rep CocoCategory x -> CocoCategory
forall x. CocoCategory -> Rep CocoCategory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoCategory -> Rep CocoCategory x
from :: forall x. CocoCategory -> Rep CocoCategory x
$cto :: forall x. Rep CocoCategory x -> CocoCategory
to :: forall x. Rep CocoCategory x -> CocoCategory
Generic)

instance FromJSON CocoCategory where
  parseJSON :: Value -> Parser CocoCategory
parseJSON = FilePath
-> (Object -> Parser CocoCategory) -> Value -> Parser CocoCategory
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"category" ((Object -> Parser CocoCategory) -> Value -> Parser CocoCategory)
-> (Object -> Parser CocoCategory) -> Value -> Parser CocoCategory
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    CategoryId
cocoCategoryId <- Object
o Object -> Key -> Parser CategoryId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
cocoCategoryName <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Text
cocoCategorySupercategory <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"supercategory"
    CocoCategory -> Parser CocoCategory
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CocoCategory {Text
CategoryId
cocoCategoryId :: CategoryId
cocoCategoryName :: Text
cocoCategorySupercategory :: Text
cocoCategoryId :: CategoryId
cocoCategoryName :: Text
cocoCategorySupercategory :: Text
..}

instance ToJSON CocoCategory where
  toJSON :: CocoCategory -> Value
toJSON CocoCategory {Text
CategoryId
cocoCategoryId :: CocoCategory -> CategoryId
cocoCategoryName :: CocoCategory -> Text
cocoCategorySupercategory :: CocoCategory -> Text
cocoCategoryId :: CategoryId
cocoCategoryName :: Text
cocoCategorySupercategory :: Text
..} =
    [Pair] -> Value
object
      [ Key
"id" Key -> CategoryId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CategoryId
cocoCategoryId,
        Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoCategoryName,
        Key
"supercategory" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cocoCategorySupercategory
      ]

data Coco = Coco
  { Coco -> Maybe CocoInfo
cocoInfo :: Maybe CocoInfo,
    Coco -> Maybe [CocoLicense]
cocoLicenses :: Maybe [CocoLicense],
    Coco -> [CocoImage]
cocoImages :: [CocoImage],
    Coco -> [CocoAnnotation]
cocoAnnotations :: [CocoAnnotation],
    Coco -> [CocoCategory]
cocoCategories :: [CocoCategory]
  }
  deriving (Int -> Coco -> ShowS
[Coco] -> ShowS
Coco -> FilePath
(Int -> Coco -> ShowS)
-> (Coco -> FilePath) -> ([Coco] -> ShowS) -> Show Coco
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coco -> ShowS
showsPrec :: Int -> Coco -> ShowS
$cshow :: Coco -> FilePath
show :: Coco -> FilePath
$cshowList :: [Coco] -> ShowS
showList :: [Coco] -> ShowS
Show, Coco -> Coco -> Bool
(Coco -> Coco -> Bool) -> (Coco -> Coco -> Bool) -> Eq Coco
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coco -> Coco -> Bool
== :: Coco -> Coco -> Bool
$c/= :: Coco -> Coco -> Bool
/= :: Coco -> Coco -> Bool
Eq, (forall x. Coco -> Rep Coco x)
-> (forall x. Rep Coco x -> Coco) -> Generic Coco
forall x. Rep Coco x -> Coco
forall x. Coco -> Rep Coco x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coco -> Rep Coco x
from :: forall x. Coco -> Rep Coco x
$cto :: forall x. Rep Coco x -> Coco
to :: forall x. Rep Coco x -> Coco
Generic)

instance FromJSON Coco where
  parseJSON :: Value -> Parser Coco
parseJSON = FilePath -> (Object -> Parser Coco) -> Value -> Parser Coco
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"coco" ((Object -> Parser Coco) -> Value -> Parser Coco)
-> (Object -> Parser Coco) -> Value -> Parser Coco
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe CocoInfo
cocoInfo <- Object
o Object -> Key -> Parser (Maybe CocoInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"info"
    Maybe [CocoLicense]
cocoLicenses <- Object
o Object -> Key -> Parser (Maybe [CocoLicense])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"licenses"
    [CocoImage]
cocoImages <- Object
o Object -> Key -> Parser [CocoImage]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"images"
    [CocoAnnotation]
cocoAnnotations <- Object
o Object -> Key -> Parser [CocoAnnotation]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotations"
    [CocoCategory]
cocoCategories <- Object
o Object -> Key -> Parser [CocoCategory]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"categories"
    Coco -> Parser Coco
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Coco {[CocoCategory]
[CocoAnnotation]
[CocoImage]
Maybe [CocoLicense]
Maybe CocoInfo
cocoInfo :: Maybe CocoInfo
cocoLicenses :: Maybe [CocoLicense]
cocoImages :: [CocoImage]
cocoAnnotations :: [CocoAnnotation]
cocoCategories :: [CocoCategory]
cocoInfo :: Maybe CocoInfo
cocoLicenses :: Maybe [CocoLicense]
cocoImages :: [CocoImage]
cocoAnnotations :: [CocoAnnotation]
cocoCategories :: [CocoCategory]
..}

instance ToJSON Coco where
  toJSON :: Coco -> Value
toJSON Coco {[CocoCategory]
[CocoAnnotation]
[CocoImage]
Maybe [CocoLicense]
Maybe CocoInfo
cocoInfo :: Coco -> Maybe CocoInfo
cocoLicenses :: Coco -> Maybe [CocoLicense]
cocoImages :: Coco -> [CocoImage]
cocoAnnotations :: Coco -> [CocoAnnotation]
cocoCategories :: Coco -> [CocoCategory]
cocoInfo :: Maybe CocoInfo
cocoLicenses :: Maybe [CocoLicense]
cocoImages :: [CocoImage]
cocoAnnotations :: [CocoAnnotation]
cocoCategories :: [CocoCategory]
..} =
    [Pair] -> Value
object
      [ Key
"info" Key -> Maybe CocoInfo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe CocoInfo
cocoInfo,
        Key
"licenses" Key -> Maybe [CocoLicense] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe [CocoLicense]
cocoLicenses,
        Key
"images" Key -> [CocoImage] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [CocoImage]
cocoImages,
        Key
"annotations" Key -> [CocoAnnotation] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [CocoAnnotation]
cocoAnnotations,
        Key
"categories" Key -> [CocoCategory] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [CocoCategory]
cocoCategories
      ]

-- Coco result format is shown in https://cocodataset.org/#format-results .

data CocoResult = CocoResult
  { CocoResult -> ImageId
cocoResultImageId :: ImageId,
    CocoResult -> CategoryId
cocoResultCategory :: CategoryId,
    CocoResult -> Score
cocoResultScore :: Score,
    CocoResult -> CoCoBoundingBox
cocoResultBbox :: CoCoBoundingBox
  }
  deriving (Int -> CocoResult -> ShowS
[CocoResult] -> ShowS
CocoResult -> FilePath
(Int -> CocoResult -> ShowS)
-> (CocoResult -> FilePath)
-> ([CocoResult] -> ShowS)
-> Show CocoResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoResult -> ShowS
showsPrec :: Int -> CocoResult -> ShowS
$cshow :: CocoResult -> FilePath
show :: CocoResult -> FilePath
$cshowList :: [CocoResult] -> ShowS
showList :: [CocoResult] -> ShowS
Show, CocoResult -> CocoResult -> Bool
(CocoResult -> CocoResult -> Bool)
-> (CocoResult -> CocoResult -> Bool) -> Eq CocoResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoResult -> CocoResult -> Bool
== :: CocoResult -> CocoResult -> Bool
$c/= :: CocoResult -> CocoResult -> Bool
/= :: CocoResult -> CocoResult -> Bool
Eq, (forall x. CocoResult -> Rep CocoResult x)
-> (forall x. Rep CocoResult x -> CocoResult) -> Generic CocoResult
forall x. Rep CocoResult x -> CocoResult
forall x. CocoResult -> Rep CocoResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoResult -> Rep CocoResult x
from :: forall x. CocoResult -> Rep CocoResult x
$cto :: forall x. Rep CocoResult x -> CocoResult
to :: forall x. Rep CocoResult x -> CocoResult
Generic)

instance FromJSON CocoResult where
  parseJSON :: Value -> Parser CocoResult
parseJSON = FilePath
-> (Object -> Parser CocoResult) -> Value -> Parser CocoResult
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"result" ((Object -> Parser CocoResult) -> Value -> Parser CocoResult)
-> (Object -> Parser CocoResult) -> Value -> Parser CocoResult
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ImageId
cocoResultImageId <- Object
o Object -> Key -> Parser ImageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image_id"
    CategoryId
cocoResultCategory <- Object
o Object -> Key -> Parser CategoryId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"category_id"
    Score
cocoResultScore <- Object
o Object -> Key -> Parser Score
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"score"
    CoCoBoundingBox
cocoResultBbox <- ([Double] -> CoCoBoundingBox)
-> Parser [Double] -> Parser CoCoBoundingBox
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Double
x, Double
y, Double
w, Double
h] -> (Double, Double, Double, Double) -> CoCoBoundingBox
CoCoBoundingBox (Double
x, Double
y, Double
w, Double
h)) (Parser [Double] -> Parser CoCoBoundingBox)
-> Parser [Double] -> Parser CoCoBoundingBox
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Key -> Parser [Double]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bbox"
    CocoResult -> Parser CocoResult
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CocoResult {CoCoBoundingBox
Score
CategoryId
ImageId
cocoResultImageId :: ImageId
cocoResultCategory :: CategoryId
cocoResultScore :: Score
cocoResultBbox :: CoCoBoundingBox
cocoResultImageId :: ImageId
cocoResultCategory :: CategoryId
cocoResultScore :: Score
cocoResultBbox :: CoCoBoundingBox
..}

instance ToJSON CocoResult where
  toJSON :: CocoResult -> Value
toJSON CocoResult {CoCoBoundingBox
Score
CategoryId
ImageId
cocoResultImageId :: CocoResult -> ImageId
cocoResultCategory :: CocoResult -> CategoryId
cocoResultScore :: CocoResult -> Score
cocoResultBbox :: CocoResult -> CoCoBoundingBox
cocoResultImageId :: ImageId
cocoResultCategory :: CategoryId
cocoResultScore :: Score
cocoResultBbox :: CoCoBoundingBox
..} =
    [Pair] -> Value
object
      [ Key
"image_id" Key -> ImageId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ImageId
cocoResultImageId,
        Key
"category_id" Key -> CategoryId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CategoryId
cocoResultCategory,
        Key
"score" Key -> Score -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Score
cocoResultScore,
        Key
"bbox" Key -> [Double] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case CoCoBoundingBox
cocoResultBbox of CoCoBoundingBox (Double
x, Double
y, Double
w, Double
h) -> [Double
x, Double
y, Double
w, Double
h]
      ]

readCoco :: FilePath -> IO Coco
readCoco :: FilePath -> IO Coco
readCoco FilePath
path = do
  ByteString
json <- FilePath -> IO ByteString
BS.readFile FilePath
path
  case ByteString -> Either FilePath Coco
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
json of
    Left FilePath
err -> FilePath -> IO Coco
forall a. HasCallStack => FilePath -> a
error FilePath
err
    Right Coco
coco -> Coco -> IO Coco
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Coco
coco

writeCoco :: FilePath -> Coco -> IO ()
writeCoco :: FilePath -> Coco -> IO ()
writeCoco FilePath
path Coco
coco = FilePath -> ByteString -> IO ()
BS.writeFile FilePath
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Coco -> ByteString
forall a. ToJSON a => a -> ByteString
encode Coco
coco

readCocoResult :: FilePath -> IO [CocoResult]
readCocoResult :: FilePath -> IO [CocoResult]
readCocoResult FilePath
path = do
  ByteString
json <- FilePath -> IO ByteString
BS.readFile FilePath
path
  case ByteString -> Either FilePath [CocoResult]
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
json of
    Left FilePath
err -> FilePath -> IO [CocoResult]
forall a. HasCallStack => FilePath -> a
error FilePath
err
    Right [CocoResult]
coco -> [CocoResult] -> IO [CocoResult]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [CocoResult]
coco

writeCocoResult :: FilePath -> [CocoResult] -> IO ()
writeCocoResult :: FilePath -> [CocoResult] -> IO ()
writeCocoResult FilePath
path [CocoResult]
coco = FilePath -> ByteString -> IO ()
BS.writeFile FilePath
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [CocoResult] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [CocoResult]
coco

getCocoImageByFileName :: Coco -> FilePath -> Maybe (CocoImage, [CocoAnnotation])
getCocoImageByFileName :: Coco -> FilePath -> Maybe (CocoImage, [CocoAnnotation])
getCocoImageByFileName Coco
coco FilePath
fileName =
  case (CocoImage -> Bool) -> [CocoImage] -> [CocoImage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CocoImage {Int
Maybe Int
Maybe Text
Text
ImageId
cocoImageId :: CocoImage -> ImageId
cocoImageWidth :: CocoImage -> Int
cocoImageHeight :: CocoImage -> Int
cocoImageFileName :: CocoImage -> Text
cocoImageLicense :: CocoImage -> Maybe Int
cocoImageDateCoco :: CocoImage -> Maybe Text
cocoImageId :: ImageId
cocoImageWidth :: Int
cocoImageHeight :: Int
cocoImageFileName :: Text
cocoImageLicense :: Maybe Int
cocoImageDateCoco :: Maybe Text
..} -> Text -> FilePath
T.unpack Text
cocoImageFileName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
fileName) ([CocoImage] -> [CocoImage]) -> [CocoImage] -> [CocoImage]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoImage]
cocoImages Coco
coco of
    [] -> Maybe (CocoImage, [CocoAnnotation])
forall a. Maybe a
Nothing
    (CocoImage
x : [CocoImage]
_) ->
      let annotations :: [CocoAnnotation]
annotations = (CocoAnnotation -> Bool) -> [CocoAnnotation] -> [CocoAnnotation]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CocoAnnotation {Double
Int
Maybe Int
Maybe [[Double]]
CoCoBoundingBox
CategoryId
ImageId
cocoAnnotationId :: CocoAnnotation -> Int
cocoAnnotationImageId :: CocoAnnotation -> ImageId
cocoAnnotationCategory :: CocoAnnotation -> CategoryId
cocoAnnotationSegment :: CocoAnnotation -> Maybe [[Double]]
cocoAnnotationArea :: CocoAnnotation -> Double
cocoAnnotationBbox :: CocoAnnotation -> CoCoBoundingBox
cocoAnnotationIsCrowd :: CocoAnnotation -> Maybe Int
cocoAnnotationId :: Int
cocoAnnotationImageId :: ImageId
cocoAnnotationCategory :: CategoryId
cocoAnnotationSegment :: Maybe [[Double]]
cocoAnnotationArea :: Double
cocoAnnotationBbox :: CoCoBoundingBox
cocoAnnotationIsCrowd :: Maybe Int
..} -> ImageId
cocoAnnotationImageId ImageId -> ImageId -> Bool
forall a. Eq a => a -> a -> Bool
== CocoImage -> ImageId
cocoImageId CocoImage
x) ([CocoAnnotation] -> [CocoAnnotation])
-> [CocoAnnotation] -> [CocoAnnotation]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoAnnotation]
cocoAnnotations Coco
coco
       in (CocoImage, [CocoAnnotation])
-> Maybe (CocoImage, [CocoAnnotation])
forall a. a -> Maybe a
Just (CocoImage
x, [CocoAnnotation]
annotations)

getCocoResultByFileName :: Coco -> [CocoResult] -> FilePath -> Maybe (CocoImage, [CocoResult])
getCocoResultByFileName :: Coco -> [CocoResult] -> FilePath -> Maybe (CocoImage, [CocoResult])
getCocoResultByFileName Coco
coco [CocoResult]
cocoResult FilePath
fileName =
  case (CocoImage -> Bool) -> [CocoImage] -> [CocoImage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CocoImage {Int
Maybe Int
Maybe Text
Text
ImageId
cocoImageId :: CocoImage -> ImageId
cocoImageWidth :: CocoImage -> Int
cocoImageHeight :: CocoImage -> Int
cocoImageFileName :: CocoImage -> Text
cocoImageLicense :: CocoImage -> Maybe Int
cocoImageDateCoco :: CocoImage -> Maybe Text
cocoImageId :: ImageId
cocoImageWidth :: Int
cocoImageHeight :: Int
cocoImageFileName :: Text
cocoImageLicense :: Maybe Int
cocoImageDateCoco :: Maybe Text
..} -> Text -> FilePath
T.unpack Text
cocoImageFileName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
fileName) ([CocoImage] -> [CocoImage]) -> [CocoImage] -> [CocoImage]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoImage]
cocoImages Coco
coco of
    [] -> Maybe (CocoImage, [CocoResult])
forall a. Maybe a
Nothing
    (CocoImage
x : [CocoImage]
_) ->
      let results :: [CocoResult]
results = (CocoResult -> Bool) -> [CocoResult] -> [CocoResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CocoResult {CoCoBoundingBox
Score
CategoryId
ImageId
cocoResultImageId :: CocoResult -> ImageId
cocoResultCategory :: CocoResult -> CategoryId
cocoResultScore :: CocoResult -> Score
cocoResultBbox :: CocoResult -> CoCoBoundingBox
cocoResultImageId :: ImageId
cocoResultCategory :: CategoryId
cocoResultScore :: Score
cocoResultBbox :: CoCoBoundingBox
..} -> ImageId
cocoResultImageId ImageId -> ImageId -> Bool
forall a. Eq a => a -> a -> Bool
== CocoImage -> ImageId
cocoImageId CocoImage
x) [CocoResult]
cocoResult
       in (CocoImage, [CocoResult]) -> Maybe (CocoImage, [CocoResult])
forall a. a -> Maybe a
Just (CocoImage
x, [CocoResult]
results)

toCocoImageMap :: Coco -> Map.Map ImageId CocoImage
toCocoImageMap :: Coco -> Map ImageId CocoImage
toCocoImageMap Coco
coco = [(ImageId, CocoImage)] -> Map ImageId CocoImage
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ImageId, CocoImage)] -> Map ImageId CocoImage)
-> [(ImageId, CocoImage)] -> Map ImageId CocoImage
forall a b. (a -> b) -> a -> b
$ (CocoImage -> (ImageId, CocoImage))
-> [CocoImage] -> [(ImageId, CocoImage)]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoImage
image -> (CocoImage -> ImageId
cocoImageId CocoImage
image, CocoImage
image)) ([CocoImage] -> [(ImageId, CocoImage)])
-> [CocoImage] -> [(ImageId, CocoImage)]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoImage]
cocoImages Coco
coco

toCocoAnnotationMap :: Coco -> Map.Map ImageId [CocoAnnotation]
toCocoAnnotationMap :: Coco -> Map ImageId [CocoAnnotation]
toCocoAnnotationMap Coco
coco = ([CocoAnnotation] -> [CocoAnnotation] -> [CocoAnnotation])
-> [(ImageId, [CocoAnnotation])] -> Map ImageId [CocoAnnotation]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [CocoAnnotation] -> [CocoAnnotation] -> [CocoAnnotation]
forall a. [a] -> [a] -> [a]
(++) ([(ImageId, [CocoAnnotation])] -> Map ImageId [CocoAnnotation])
-> [(ImageId, [CocoAnnotation])] -> Map ImageId [CocoAnnotation]
forall a b. (a -> b) -> a -> b
$ (CocoAnnotation -> (ImageId, [CocoAnnotation]))
-> [CocoAnnotation] -> [(ImageId, [CocoAnnotation])]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoAnnotation
annotation -> (CocoAnnotation -> ImageId
cocoAnnotationImageId CocoAnnotation
annotation, [CocoAnnotation
annotation])) ([CocoAnnotation] -> [(ImageId, [CocoAnnotation])])
-> [CocoAnnotation] -> [(ImageId, [CocoAnnotation])]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoAnnotation]
cocoAnnotations Coco
coco

toCategoryMap :: Coco -> Map.Map CategoryId CocoCategory
toCategoryMap :: Coco -> Map CategoryId CocoCategory
toCategoryMap Coco
coco = [(CategoryId, CocoCategory)] -> Map CategoryId CocoCategory
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CategoryId, CocoCategory)] -> Map CategoryId CocoCategory)
-> [(CategoryId, CocoCategory)] -> Map CategoryId CocoCategory
forall a b. (a -> b) -> a -> b
$ (CocoCategory -> (CategoryId, CocoCategory))
-> [CocoCategory] -> [(CategoryId, CocoCategory)]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoCategory
category -> (CocoCategory -> CategoryId
cocoCategoryId CocoCategory
category, CocoCategory
category)) ([CocoCategory] -> [(CategoryId, CocoCategory)])
-> [CocoCategory] -> [(CategoryId, CocoCategory)]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoCategory]
cocoCategories Coco
coco

toFilepathMap :: Coco -> Map.Map ImageId FilePath
toFilepathMap :: Coco -> Map ImageId FilePath
toFilepathMap Coco
coco = [(ImageId, FilePath)] -> Map ImageId FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ImageId, FilePath)] -> Map ImageId FilePath)
-> [(ImageId, FilePath)] -> Map ImageId FilePath
forall a b. (a -> b) -> a -> b
$ (CocoImage -> (ImageId, FilePath))
-> [CocoImage] -> [(ImageId, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoImage
image -> (CocoImage -> ImageId
cocoImageId CocoImage
image, Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ CocoImage -> Text
cocoImageFileName CocoImage
image)) ([CocoImage] -> [(ImageId, FilePath)])
-> [CocoImage] -> [(ImageId, FilePath)]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoImage]
cocoImages Coco
coco

-- | Convert coco to image id map
-- | Key is image file name, and value is a list of image id
toImageId :: Coco -> Map.Map FilePath [ImageId]
toImageId :: Coco -> Map FilePath [ImageId]
toImageId Coco
coco = ([ImageId] -> [ImageId] -> [ImageId])
-> [(FilePath, [ImageId])] -> Map FilePath [ImageId]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [ImageId] -> [ImageId] -> [ImageId]
forall a. [a] -> [a] -> [a]
(++) ([(FilePath, [ImageId])] -> Map FilePath [ImageId])
-> [(FilePath, [ImageId])] -> Map FilePath [ImageId]
forall a b. (a -> b) -> a -> b
$ (CocoImage -> (FilePath, [ImageId]))
-> [CocoImage] -> [(FilePath, [ImageId])]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoImage
image -> (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ CocoImage -> Text
cocoImageFileName CocoImage
image, [CocoImage -> ImageId
cocoImageId CocoImage
image])) ([CocoImage] -> [(FilePath, [ImageId])])
-> [CocoImage] -> [(FilePath, [ImageId])]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoImage]
cocoImages Coco
coco

toCocoResultMap :: [CocoResult] -> Map.Map ImageId [CocoResult]
toCocoResultMap :: [CocoResult] -> Map ImageId [CocoResult]
toCocoResultMap [CocoResult]
cocoResult = ([CocoResult] -> [CocoResult] -> [CocoResult])
-> [(ImageId, [CocoResult])] -> Map ImageId [CocoResult]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [CocoResult] -> [CocoResult] -> [CocoResult]
forall a. [a] -> [a] -> [a]
(++) ([(ImageId, [CocoResult])] -> Map ImageId [CocoResult])
-> [(ImageId, [CocoResult])] -> Map ImageId [CocoResult]
forall a b. (a -> b) -> a -> b
$ (CocoResult -> (ImageId, [CocoResult]))
-> [CocoResult] -> [(ImageId, [CocoResult])]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoResult
result -> (CocoResult -> ImageId
cocoResultImageId CocoResult
result, [CocoResult
result])) [CocoResult]
cocoResult

data CocoMap = CocoMap
  { CocoMap -> Map FilePath [ImageId]
cocoMapImageId :: Map.Map FilePath [ImageId],
    CocoMap -> Map ImageId CocoImage
cocoMapCocoImage :: Map.Map ImageId CocoImage,
    CocoMap -> Map ImageId [CocoAnnotation]
cocoMapCocoAnnotation :: Map.Map ImageId [CocoAnnotation],
    CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory :: Map.Map CategoryId CocoCategory,
    CocoMap -> Map ImageId [CocoResult]
cocoMapCocoResult :: Map.Map ImageId [CocoResult],
    CocoMap -> Map ImageId FilePath
cocoMapFilepath :: Map.Map ImageId FilePath,
    CocoMap -> [ImageId]
cocoMapImageIds :: [ImageId],
    CocoMap -> [CategoryId]
cocoMapCategoryIds :: [CategoryId]
  }
  deriving (Int -> CocoMap -> ShowS
[CocoMap] -> ShowS
CocoMap -> FilePath
(Int -> CocoMap -> ShowS)
-> (CocoMap -> FilePath) -> ([CocoMap] -> ShowS) -> Show CocoMap
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CocoMap -> ShowS
showsPrec :: Int -> CocoMap -> ShowS
$cshow :: CocoMap -> FilePath
show :: CocoMap -> FilePath
$cshowList :: [CocoMap] -> ShowS
showList :: [CocoMap] -> ShowS
Show, CocoMap -> CocoMap -> Bool
(CocoMap -> CocoMap -> Bool)
-> (CocoMap -> CocoMap -> Bool) -> Eq CocoMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CocoMap -> CocoMap -> Bool
== :: CocoMap -> CocoMap -> Bool
$c/= :: CocoMap -> CocoMap -> Bool
/= :: CocoMap -> CocoMap -> Bool
Eq, (forall x. CocoMap -> Rep CocoMap x)
-> (forall x. Rep CocoMap x -> CocoMap) -> Generic CocoMap
forall x. Rep CocoMap x -> CocoMap
forall x. CocoMap -> Rep CocoMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CocoMap -> Rep CocoMap x
from :: forall x. CocoMap -> Rep CocoMap x
$cto :: forall x. Rep CocoMap x -> CocoMap
to :: forall x. Rep CocoMap x -> CocoMap
Generic)

toCocoMap :: Coco -> [CocoResult] -> CocoMap
toCocoMap :: Coco -> [CocoResult] -> CocoMap
toCocoMap Coco
coco [CocoResult]
cocoResult =
  let cocoMapImageId :: Map FilePath [ImageId]
cocoMapImageId = Coco -> Map FilePath [ImageId]
toImageId Coco
coco
      cocoMapCocoImage :: Map ImageId CocoImage
cocoMapCocoImage = Coco -> Map ImageId CocoImage
toCocoImageMap Coco
coco
      cocoMapCocoAnnotation :: Map ImageId [CocoAnnotation]
cocoMapCocoAnnotation = Coco -> Map ImageId [CocoAnnotation]
toCocoAnnotationMap Coco
coco
      cocoMapCocoCategory :: Map CategoryId CocoCategory
cocoMapCocoCategory = Coco -> Map CategoryId CocoCategory
toCategoryMap Coco
coco
      cocoMapCocoResult :: Map ImageId [CocoResult]
cocoMapCocoResult = [CocoResult] -> Map ImageId [CocoResult]
toCocoResultMap [CocoResult]
cocoResult
      cocoMapFilepath :: Map ImageId FilePath
cocoMapFilepath = Coco -> Map ImageId FilePath
toFilepathMap Coco
coco
      cocoMapImageIds :: [ImageId]
cocoMapImageIds = (CocoImage -> ImageId) -> [CocoImage] -> [ImageId]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoImage {Int
Maybe Int
Maybe Text
Text
ImageId
cocoImageId :: CocoImage -> ImageId
cocoImageWidth :: CocoImage -> Int
cocoImageHeight :: CocoImage -> Int
cocoImageFileName :: CocoImage -> Text
cocoImageLicense :: CocoImage -> Maybe Int
cocoImageDateCoco :: CocoImage -> Maybe Text
cocoImageId :: ImageId
cocoImageWidth :: Int
cocoImageHeight :: Int
cocoImageFileName :: Text
cocoImageLicense :: Maybe Int
cocoImageDateCoco :: Maybe Text
..} -> ImageId
cocoImageId) ([CocoImage] -> [ImageId]) -> [CocoImage] -> [ImageId]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoImage]
cocoImages Coco
coco
      cocoMapCategoryIds :: [CategoryId]
cocoMapCategoryIds = (CocoCategory -> CategoryId) -> [CocoCategory] -> [CategoryId]
forall a b. (a -> b) -> [a] -> [b]
map (\CocoCategory {Text
CategoryId
cocoCategoryId :: CocoCategory -> CategoryId
cocoCategoryName :: CocoCategory -> Text
cocoCategorySupercategory :: CocoCategory -> Text
cocoCategoryId :: CategoryId
cocoCategoryName :: Text
cocoCategorySupercategory :: Text
..} -> CategoryId
cocoCategoryId) ([CocoCategory] -> [CategoryId]) -> [CocoCategory] -> [CategoryId]
forall a b. (a -> b) -> a -> b
$ Coco -> [CocoCategory]
cocoCategories Coco
coco
   in CocoMap {[CategoryId]
[ImageId]
Map FilePath [ImageId]
Map CategoryId CocoCategory
Map ImageId FilePath
Map ImageId [CocoResult]
Map ImageId [CocoAnnotation]
Map ImageId CocoImage
cocoMapImageId :: Map FilePath [ImageId]
cocoMapCocoImage :: Map ImageId CocoImage
cocoMapCocoAnnotation :: Map ImageId [CocoAnnotation]
cocoMapCocoCategory :: Map CategoryId CocoCategory
cocoMapCocoResult :: Map ImageId [CocoResult]
cocoMapFilepath :: Map ImageId FilePath
cocoMapImageIds :: [ImageId]
cocoMapCategoryIds :: [CategoryId]
cocoMapImageId :: Map FilePath [ImageId]
cocoMapCocoImage :: Map ImageId CocoImage
cocoMapCocoAnnotation :: Map ImageId [CocoAnnotation]
cocoMapCocoCategory :: Map CategoryId CocoCategory
cocoMapCocoResult :: Map ImageId [CocoResult]
cocoMapFilepath :: Map ImageId FilePath
cocoMapImageIds :: [ImageId]
cocoMapCategoryIds :: [CategoryId]
..}