{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module RiskWeaver.DSL.Core where

import Control.Monad.Trans.Reader (ReaderT, ask)
import Data.Kind (Type)
import Data.Map (Map)
import Data.Vector (Vector)

class BoundingBox a where
  type Detection a :: Type
  type ClassG a :: Type
  type ClassD a :: Type
  data ErrorType a :: Type
  type InterestArea a :: Type
  type InterestObject a :: Type
  data Env a :: Type
  type Idx a :: Type
  type Risk a :: Type

  riskE :: Env a -> Risk a
  interestArea :: Env a -> InterestArea a
  interestObject :: Env a -> InterestObject a
  groundTruth :: Env a -> Vector a
  detection :: Env a -> Vector (Detection a)
  confidenceScoreThresh :: Env a -> Double
  ioUThresh :: Env a -> Double
  scoreD :: Detection a -> Double
  sizeD :: Detection a -> Double
  classD :: Detection a -> ClassG a
  idD :: Detection a -> Idx a

  isFrontD :: Detection a -> Detection a -> Bool
  isBackD :: Detection a -> Detection a -> Bool
  isLeftD :: Detection a -> Detection a -> Bool
  isRightD :: Detection a -> Detection a -> Bool
  isTopD :: Detection a -> Detection a -> Bool
  isBottomD :: Detection a -> Detection a -> Bool
  isBackGroundD :: ClassD a -> Bool
  detectD :: Env a -> Detection a -> Maybe a
  errorType :: Env a -> Detection a -> Maybe (ErrorType a)

  sizeG :: a -> Double
  classG :: a -> ClassG a
  angle :: a -> Detection a -> Double
  idG :: a -> Idx a
  ioU :: a -> Detection a -> Double
  ioG :: a -> Detection a -> Double
  ioD :: a -> Detection a -> Double
  detectG :: Env a -> a -> Maybe (Detection a)

  isInIeterestAreaD :: InterestArea a -> Detection a -> Bool
  isInIeterestAreaG :: InterestArea a -> a -> Bool

  riskD :: Env a -> Detection a -> Risk a
  riskBB :: Env a -> Risk a

  confusionMatrixRecallBB :: Env a -> Map (ClassG a, ClassD a) Double
  confusionMatrixAccuracyBB :: Env a -> Map (ClassD a, ClassG a) Double
  confusionMatrixRecallBB' :: Env a -> Map (ClassG a, ClassD a) [Idx a]
  confusionMatrixAccuracyBB' :: Env a -> Map (ClassD a, ClassG a) [Idx a]
  errorGroupsBB :: Env a -> Map (ClassG a) (Map (ErrorType a) [Idx a])

class (BoundingBox a) => World a where
  type Image a :: Type
  idI :: Image a -> Int
  env :: Image a -> Env a
  mAP :: Vector (Image a) -> Double
  ap :: Vector (Image a) -> Map (ClassG a) Double
  risk :: Vector (Image a) -> Double
  confusionMatrixRecall :: Vector (Image a) -> Map (ClassG a, ClassD a) Double
  confusionMatrixAccuracy :: Vector (Image a) -> Map (ClassD a, ClassG a) Double
  confusionMatrixRecall' :: Vector (Image a) -> Map (ClassG a, ClassD a) [Idx a]
  confusionMatrixAccuracy' :: Vector (Image a) -> Map (ClassD a, ClassG a) [Idx a]
  errorGroups :: Vector (Image a) -> Map (ClassG a) (Map (ErrorType a) [Idx a])

loopG :: forall a m b. (BoundingBox a, Monad m) => (b -> b -> b) -> b -> (a -> ReaderT (Env a) m b) -> ReaderT (Env a) m b
loopG :: forall a (m :: * -> *) b.
(BoundingBox a, Monad m) =>
(b -> b -> b)
-> b -> (a -> ReaderT (Env a) m b) -> ReaderT (Env a) m b
loopG b -> b -> b
add b
init a -> ReaderT (Env a) m b
fn = do
  Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  (b -> b -> b) -> b -> Vector b -> b
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> b -> b
add b
init (Vector b -> b)
-> ReaderT (Env a) m (Vector b) -> ReaderT (Env a) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> ReaderT (Env a) m b)
-> Vector a -> ReaderT (Env a) m (Vector b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM a -> ReaderT (Env a) m b
fn (forall a. BoundingBox a => Env a -> Vector a
groundTruth @a Env a
env)

loopD :: forall a m b. (BoundingBox a, Monad m) => (b -> b -> b) -> b -> (Detection a -> ReaderT (Env a) m b) -> ReaderT (Env a) m b
loopD :: forall a (m :: * -> *) b.
(BoundingBox a, Monad m) =>
(b -> b -> b)
-> b -> (Detection a -> ReaderT (Env a) m b) -> ReaderT (Env a) m b
loopD b -> b -> b
add b
init Detection a -> ReaderT (Env a) m b
fn = do
  Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  (b -> b -> b) -> b -> Vector b -> b
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> b -> b
add b
init (Vector b -> b)
-> ReaderT (Env a) m (Vector b) -> ReaderT (Env a) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Detection a -> ReaderT (Env a) m b)
-> Vector (Detection a) -> ReaderT (Env a) m (Vector b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Detection a -> ReaderT (Env a) m b
fn (forall a. BoundingBox a => Env a -> Vector (Detection a)
detection @a Env a
env)