content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module OpenCV.JSON ( ) where
  
  import "aeson" Data.Aeson
  import "aeson" Data.Aeson.Types ( Parser )
  import "aeson" Data.Aeson.TH
  import "base" Data.Int ( Int32 )
  import "base" Data.Monoid ( (<>) )
  import "base" Data.Proxy ( Proxy(..) )
  import "linear" Linear.V2 ( V2(..) )
  import "linear" Linear.V3 ( V3(..) )
  import "text" Data.Text ( Text )
  import qualified "text" Data.Text as T ( unpack )
  import "this" OpenCV.Core.Types
  import "this" OpenCV.Core.Types.Mat.HMat
  import "this" OpenCV.TypeLevel
  import "transformers" Control.Monad.Trans.Except
  
  #ifndef OPENCV4
  import qualified "base64-bytestring" Data.ByteString.Base64 as B64 ( encode, decode )
  import qualified "text" Data.Text.Encoding as TE ( encodeUtf8, decodeUtf8 )
  #endif
  
  --------------------------------------------------------------------------------
  
  newtype J a = J {unJ :: a}
  
  instance (ToJSON a) => ToJSON (J (V2 a)) where
      toJSON (J (V2 x y)) = toJSON (x, y)
  
  instance (ToJSON a) => ToJSON (J (V3 a)) where
      toJSON (J (V3 x y z)) = toJSON (x, y, z)
  
  instance (FromJSON a) => FromJSON (J (V2 a)) where
      parseJSON = fmap (\(x, y) -> J $ V2 x y) . parseJSON
  
  instance (FromJSON a) => FromJSON (J (V3 a)) where
      parseJSON = fmap (\(x, y, z) -> J $ V3 x y z) . parseJSON
  
  
  --------------------------------------------------------------------------------
  
  #define IsoJSON(A, B, A_to_B, B_to_A)                \
  instance ToJSON A where {                            \
      toJSON = toJSON . (A_to_B :: A -> B);            \
  };                                                   \
  instance FromJSON A where {                          \
      parseJSON = fmap (B_to_A :: B -> A) . parseJSON; \
  }
  
  --------------------------------------------------------------------------------
  IsoJSON(Point2i, J (V2 Int32 ), J .                   fromPoint, toPoint                   . unJ)
  IsoJSON(Point2f, J (V2 Float ), J . fmap realToFrac . fromPoint, toPoint . fmap realToFrac . unJ)
  IsoJSON(Point2d, J (V2 Double), J . fmap realToFrac . fromPoint, toPoint . fmap realToFrac . unJ)
  IsoJSON(Point3i, J (V3 Int32 ), J .                   fromPoint, toPoint                   . unJ)
  IsoJSON(Point3f, J (V3 Float ), J . fmap realToFrac . fromPoint, toPoint . fmap realToFrac . unJ)
  IsoJSON(Point3d, J (V3 Double), J . fmap realToFrac . fromPoint, toPoint . fmap realToFrac . unJ)
  IsoJSON(Size2i , J (V2 Int32 ), J .                   fromSize , toSize                    . unJ)
  IsoJSON(Size2f , J (V2 Float ), J . fmap realToFrac . fromSize , toSize  . fmap realToFrac . unJ)
  
  deriveJSON defaultOptions {fieldLabelModifier = drop 2} ''HMat
  
  instance ToJSON (Mat shape channels depth) where
      toJSON = toJSON . matToHMat
  
  instance ( ToShapeDS    (Proxy shape)
           , ToChannelsDS (Proxy channels)
           , ToDepthDS    (Proxy depth)
           )
        => FromJSON (Mat shape channels depth) where
      parseJSON value = do
        matDyn <- hMatToMat <$> parseJSON value
        case runExcept $ coerceMat (matDyn :: Mat 'D 'D 'D) of
          Left err -> fail $ show err
          Right mat -> pure mat
  
  
  --------------------------------------------------------------------------------
  
  instance ToJSON HElems where
      toJSON = \case
          HElems_8U       v -> f "8U"  v
          HElems_8S       v -> f "8S"  v
          HElems_16U      v -> f "16U" v
          HElems_16S      v -> f "16S" v
          HElems_32S      v -> f "32S" v
          HElems_32F      v -> f "32F" v
          HElems_64F      v -> f "64F" v
  #ifndef OPENCV4
          HElems_USRTYPE1 v -> f "USR" $ fmap (TE.decodeUtf8 . B64.encode) v
  #endif
        where
          f :: (ToJSON a) => Text -> a -> Value
          f typ v = object [ "type"  .= typ
                           , "elems" .= v
                           ]
  
  instance FromJSON HElems where
      parseJSON = withObject "HElems" $ \obj -> do
                    typ <- obj .: "type"
                    let elems :: (FromJSON a) => Parser a
                        elems = obj .: "elems"
                    case typ of
                      "8U"  -> HElems_8U       <$> elems
                      "8S"  -> HElems_8S       <$> elems
                      "16U" -> HElems_16U      <$> elems
                      "16S" -> HElems_16S      <$> elems
                      "32S" -> HElems_32S      <$> elems
                      "32F" -> HElems_32F      <$> elems
                      "64F" -> HElems_64F      <$> elems
  #ifndef OPENCV4
                      "USR" -> HElems_USRTYPE1 <$> (mapM (either fail pure . B64.decode . TE.encodeUtf8) =<< elems)
  #endif
                      _ -> fail $ "Unknown Helems type " <> T.unpack typ
  
  --------------------------------------------------------------------------------
  
  