{-# LANGUAGE DeriveFunctor #-}

-- | 2D geometry primitives — a small module used to show off the
-- __Kedgeree__ Haddock theme.
--
-- It exercises the things a theme has to get right: section headings,
-- data declarations with record fields, type classes with methods and
-- instances, operators, and inline @code@ / code blocks.
--
-- > let unit = Circle origin 1
-- > area unit  -- ≈ 3.14159
--
-- Bold like __this__, emphasis like /this/, and a link to 'Shape'.
module Geometry
  ( -- * Points
    Point (..)
  , origin
  , translate
  , (.+.)

    -- * Shapes
  , Shape (..)
  , circle
  , rectangle

    -- * Measuring things
  , Measurable (..)
  ) where

-- | A point in the plane.
data Point = Point
  { Point -> Double
px :: !Double
  -- ^ the x coordinate
  , Point -> Double
py :: !Double
  -- ^ the y coordinate
  }
  deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
/= :: Point -> Point -> Bool
Eq, Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Point -> ShowS
showsPrec :: Int -> Point -> ShowS
$cshow :: Point -> String
show :: Point -> String
$cshowList :: [Point] -> ShowS
showList :: [Point] -> ShowS
Show)

-- | The origin, @Point 0 0@.
origin :: Point
origin :: Point
origin = Double -> Double -> Point
Point Double
0 Double
0

-- | Move a point by a delta given as another point.
--
-- @since 0.1.0
translate :: Point -> Point -> Point
translate :: Point -> Point -> Point
translate (Point Double
dx Double
dy) (Point Double
x Double
y) = Double -> Double -> Point
Point (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dx) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy)

-- | Infix alias for 'translate'.
(.+.) :: Point -> Point -> Point
.+. :: Point -> Point -> Point
(.+.) = Point -> Point -> Point
translate

infixl 6 .+.

-- | A geometric shape.
data Shape
  = -- | a circle given its centre and radius
    Circle Point Double
  | -- | an axis-aligned rectangle given two opposite corners
    Rectangle Point Point
  deriving (Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
/= :: Shape -> Shape -> Bool
Eq, Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Shape -> ShowS
showsPrec :: Int -> Shape -> ShowS
$cshow :: Shape -> String
show :: Shape -> String
$cshowList :: [Shape] -> ShowS
showList :: [Shape] -> ShowS
Show)

-- | Smart constructor for a circle.
circle :: Point -> Double -> Shape
circle :: Point -> Double -> Shape
circle = Point -> Double -> Shape
Circle

-- | Smart constructor for a rectangle from its width and height,
-- anchored at the 'origin'.
rectangle :: Double -> Double -> Shape
rectangle :: Double -> Double -> Shape
rectangle Double
w Double
h = Point -> Point -> Shape
Rectangle Point
origin (Double -> Double -> Point
Point Double
w Double
h)

-- | Things that have an 'area' and a 'perimeter'.
class Measurable a where
  -- | The enclosed area.
  area :: a -> Double

  -- | The length of the boundary.
  perimeter :: a -> Double

instance Measurable Shape where
  area :: Shape -> Double
area (Circle Point
_ Double
r) = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r
  area (Rectangle (Point Double
x0 Double
y0) (Point Double
x1 Double
y1)) = Double -> Double
forall a. Num a => a -> a
abs (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Num a => a -> a
abs (Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y0)

  perimeter :: Shape -> Double
perimeter (Circle Point
_ Double
r) = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r
  perimeter (Rectangle (Point Double
x0 Double
y0) (Point Double
x1 Double
y1)) =
    Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Num a => a -> a
abs (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x0) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Num a => a -> a
abs (Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y0))