never executed always true always false

    1 {-# language CPP #-}
    2 {-# language ConstraintKinds #-}
    3 {-# language DeriveFunctor #-}
    4 {-# language DeriveTraversable #-}
    5 {-# language MultiParamTypeClasses #-}
    6 {-# language UndecidableInstances #-}
    7 
    8 #ifndef ENABLE_INTERNAL_DOCUMENTATION
    9 {-# OPTIONS_HADDOCK hide #-}
   10 #endif
   11 
   12 module OpenCV.Internal.Core.Types.Rect
   13   ( Rect(..)
   14   , RectPoint
   15   , RectSize
   16   , HRect(..)
   17   , IsRect(..)
   18   ) where
   19 
   20 import "aeson" Data.Aeson
   21 import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr )
   22 import "linear" Linear.V2 ( V2(..) )
   23 import "this" OpenCV.Internal.C.Types
   24 import "this" OpenCV.Core.Types.Point ( Point )
   25 import "this" OpenCV.Core.Types.Size ( Size )
   26 #if MIN_VERSION_base(4,9,0)
   27 import "base" Data.Foldable ( Foldable )
   28 import "base" Data.Traversable ( Traversable )
   29 #endif
   30 
   31 --------------------------------------------------------------------------------
   32 
   33 newtype Rect (depth :: *)
   34       = Rect {unRect :: ForeignPtr (C'Rect depth)}
   35 
   36 type instance C (Rect depth) = C'Rect depth
   37 
   38 instance WithPtr (Rect depth) where withPtr = withForeignPtr . unRect
   39 
   40 -- | Native Haskell represenation of a rectangle.
   41 data HRect a
   42    = HRect
   43      { hRectTopLeft :: !(V2 a)
   44      , hRectSize    :: !(V2 a)
   45      } deriving (Foldable, Functor, Traversable, Show)
   46 
   47 type family RectPoint (r :: * -> *) :: * -> *
   48 type family RectSize  (r :: * -> *) :: * -> *
   49 
   50 type instance RectPoint Rect = Point 2
   51 type instance RectSize  Rect = Size
   52 
   53 type instance RectPoint HRect = V2
   54 type instance RectSize  HRect = V2
   55 
   56 class IsRect (r :: * -> *) (depth :: *) where
   57     toRect   :: r depth -> Rect depth
   58     fromRect :: Rect depth -> r depth
   59 
   60     toRectIO :: r depth -> IO (Rect depth)
   61     toRectIO = pure . toRect
   62 
   63     rectTopLeft     :: r depth -> RectPoint r depth
   64     rectBottomRight :: r depth -> RectPoint r depth
   65     rectSize        :: r depth -> RectSize  r depth
   66     rectArea        :: r depth -> depth
   67     rectContains    :: RectPoint r depth -> r depth -> Bool
   68 
   69 --------------------------------------------------------------------------------
   70 
   71 instance (IsRect HRect a, Show a)
   72       => Show (Rect a) where
   73     showsPrec prec rect = showParen (prec >= 10) $
   74                               showString "toRect "
   75                             . showParen True (shows hr)
   76       where
   77         hr :: HRect a
   78         hr = fromRect rect
   79 
   80 instance (ToJSON a) => ToJSON (HRect a) where
   81     toJSON hr = object [ "pos"  .= (x, y)
   82                        , "size" .= (w, h)
   83                        ]
   84       where
   85         V2 x y = hRectTopLeft hr
   86         V2 w h = hRectSize    hr
   87 
   88 instance (FromJSON a) => FromJSON (HRect a) where
   89     parseJSON = withObject "HRect" $ \obj ->
   90                   HRect  <$> (uncurry V2 <$> obj .: "pos")
   91                          <*> (uncurry V2 <$> obj .: "size")
   92 
   93 instance ( ToJSON a
   94          , IsRect HRect a
   95          )
   96       => ToJSON (Rect a) where
   97     toJSON = toJSON . (fromRect :: Rect a -> HRect a)
   98 
   99 instance ( FromJSON a
  100          , IsRect HRect a
  101          )
  102       => FromJSON (Rect a) where
  103     parseJSON value = (toRect :: HRect a -> Rect a) <$> parseJSON value