{-# LANGUAGE TemplateHaskell #-}
module Data.Geometry.Box.Sides( Sides(Sides), north, east, south, west
, topSide, bottomSide, leftSide, rightSide
, sides, sides'
, sideDirections
) where
import Data.Geometry.Directions
import Data.Geometry.Box.Internal
import Data.Geometry.Box.Corners
import Data.Geometry.LineSegment
import Data.Functor.Apply
import Data.Semigroup.Foldable.Class
import Data.Semigroup.Traversable.Class
import GHC.Generics (Generic)
import Control.Lens(makeLenses, Ixed(..), Index, IxValue)
data Sides a = Sides { Sides a -> a
_north :: !a
, Sides a -> a
_east :: !a
, Sides a -> a
_south :: !a
, Sides a -> a
_west :: !a
} deriving (Int -> Sides a -> ShowS
[Sides a] -> ShowS
Sides a -> String
(Int -> Sides a -> ShowS)
-> (Sides a -> String) -> ([Sides a] -> ShowS) -> Show (Sides a)
forall a. Show a => Int -> Sides a -> ShowS
forall a. Show a => [Sides a] -> ShowS
forall a. Show a => Sides a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sides a] -> ShowS
$cshowList :: forall a. Show a => [Sides a] -> ShowS
show :: Sides a -> String
$cshow :: forall a. Show a => Sides a -> String
showsPrec :: Int -> Sides a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sides a -> ShowS
Show,ReadPrec [Sides a]
ReadPrec (Sides a)
Int -> ReadS (Sides a)
ReadS [Sides a]
(Int -> ReadS (Sides a))
-> ReadS [Sides a]
-> ReadPrec (Sides a)
-> ReadPrec [Sides a]
-> Read (Sides a)
forall a. Read a => ReadPrec [Sides a]
forall a. Read a => ReadPrec (Sides a)
forall a. Read a => Int -> ReadS (Sides a)
forall a. Read a => ReadS [Sides a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sides a]
$creadListPrec :: forall a. Read a => ReadPrec [Sides a]
readPrec :: ReadPrec (Sides a)
$creadPrec :: forall a. Read a => ReadPrec (Sides a)
readList :: ReadS [Sides a]
$creadList :: forall a. Read a => ReadS [Sides a]
readsPrec :: Int -> ReadS (Sides a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Sides a)
Read,Sides a -> Sides a -> Bool
(Sides a -> Sides a -> Bool)
-> (Sides a -> Sides a -> Bool) -> Eq (Sides a)
forall a. Eq a => Sides a -> Sides a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sides a -> Sides a -> Bool
$c/= :: forall a. Eq a => Sides a -> Sides a -> Bool
== :: Sides a -> Sides a -> Bool
$c== :: forall a. Eq a => Sides a -> Sides a -> Bool
Eq,(forall x. Sides a -> Rep (Sides a) x)
-> (forall x. Rep (Sides a) x -> Sides a) -> Generic (Sides a)
forall x. Rep (Sides a) x -> Sides a
forall x. Sides a -> Rep (Sides a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Sides a) x -> Sides a
forall a x. Sides a -> Rep (Sides a) x
$cto :: forall a x. Rep (Sides a) x -> Sides a
$cfrom :: forall a x. Sides a -> Rep (Sides a) x
Generic,Eq (Sides a)
Eq (Sides a)
-> (Sides a -> Sides a -> Ordering)
-> (Sides a -> Sides a -> Bool)
-> (Sides a -> Sides a -> Bool)
-> (Sides a -> Sides a -> Bool)
-> (Sides a -> Sides a -> Bool)
-> (Sides a -> Sides a -> Sides a)
-> (Sides a -> Sides a -> Sides a)
-> Ord (Sides a)
Sides a -> Sides a -> Bool
Sides a -> Sides a -> Ordering
Sides a -> Sides a -> Sides a
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
forall a. Ord a => Eq (Sides a)
forall a. Ord a => Sides a -> Sides a -> Bool
forall a. Ord a => Sides a -> Sides a -> Ordering
forall a. Ord a => Sides a -> Sides a -> Sides a
min :: Sides a -> Sides a -> Sides a
$cmin :: forall a. Ord a => Sides a -> Sides a -> Sides a
max :: Sides a -> Sides a -> Sides a
$cmax :: forall a. Ord a => Sides a -> Sides a -> Sides a
>= :: Sides a -> Sides a -> Bool
$c>= :: forall a. Ord a => Sides a -> Sides a -> Bool
> :: Sides a -> Sides a -> Bool
$c> :: forall a. Ord a => Sides a -> Sides a -> Bool
<= :: Sides a -> Sides a -> Bool
$c<= :: forall a. Ord a => Sides a -> Sides a -> Bool
< :: Sides a -> Sides a -> Bool
$c< :: forall a. Ord a => Sides a -> Sides a -> Bool
compare :: Sides a -> Sides a -> Ordering
$ccompare :: forall a. Ord a => Sides a -> Sides a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Sides a)
Ord,Sides a -> Bool
(a -> m) -> Sides a -> m
(a -> b -> b) -> b -> Sides a -> b
(forall m. Monoid m => Sides m -> m)
-> (forall m a. Monoid m => (a -> m) -> Sides a -> m)
-> (forall m a. Monoid m => (a -> m) -> Sides a -> m)
-> (forall a b. (a -> b -> b) -> b -> Sides a -> b)
-> (forall a b. (a -> b -> b) -> b -> Sides a -> b)
-> (forall b a. (b -> a -> b) -> b -> Sides a -> b)
-> (forall b a. (b -> a -> b) -> b -> Sides a -> b)
-> (forall a. (a -> a -> a) -> Sides a -> a)
-> (forall a. (a -> a -> a) -> Sides a -> a)
-> (forall a. Sides a -> [a])
-> (forall a. Sides a -> Bool)
-> (forall a. Sides a -> Int)
-> (forall a. Eq a => a -> Sides a -> Bool)
-> (forall a. Ord a => Sides a -> a)
-> (forall a. Ord a => Sides a -> a)
-> (forall a. Num a => Sides a -> a)
-> (forall a. Num a => Sides a -> a)
-> Foldable Sides
forall a. Eq a => a -> Sides a -> Bool
forall a. Num a => Sides a -> a
forall a. Ord a => Sides a -> a
forall m. Monoid m => Sides m -> m
forall a. Sides a -> Bool
forall a. Sides a -> Int
forall a. Sides a -> [a]
forall a. (a -> a -> a) -> Sides a -> a
forall m a. Monoid m => (a -> m) -> Sides a -> m
forall b a. (b -> a -> b) -> b -> Sides a -> b
forall a b. (a -> b -> b) -> b -> Sides a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Sides a -> a
$cproduct :: forall a. Num a => Sides a -> a
sum :: Sides a -> a
$csum :: forall a. Num a => Sides a -> a
minimum :: Sides a -> a
$cminimum :: forall a. Ord a => Sides a -> a
maximum :: Sides a -> a
$cmaximum :: forall a. Ord a => Sides a -> a
elem :: a -> Sides a -> Bool
$celem :: forall a. Eq a => a -> Sides a -> Bool
length :: Sides a -> Int
$clength :: forall a. Sides a -> Int
null :: Sides a -> Bool
$cnull :: forall a. Sides a -> Bool
toList :: Sides a -> [a]
$ctoList :: forall a. Sides a -> [a]
foldl1 :: (a -> a -> a) -> Sides a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Sides a -> a
foldr1 :: (a -> a -> a) -> Sides a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Sides a -> a
foldl' :: (b -> a -> b) -> b -> Sides a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Sides a -> b
foldl :: (b -> a -> b) -> b -> Sides a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Sides a -> b
foldr' :: (a -> b -> b) -> b -> Sides a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Sides a -> b
foldr :: (a -> b -> b) -> b -> Sides a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Sides a -> b
foldMap' :: (a -> m) -> Sides a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Sides a -> m
foldMap :: (a -> m) -> Sides a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Sides a -> m
fold :: Sides m -> m
$cfold :: forall m. Monoid m => Sides m -> m
Foldable,a -> Sides b -> Sides a
(a -> b) -> Sides a -> Sides b
(forall a b. (a -> b) -> Sides a -> Sides b)
-> (forall a b. a -> Sides b -> Sides a) -> Functor Sides
forall a b. a -> Sides b -> Sides a
forall a b. (a -> b) -> Sides a -> Sides b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Sides b -> Sides a
$c<$ :: forall a b. a -> Sides b -> Sides a
fmap :: (a -> b) -> Sides a -> Sides b
$cfmap :: forall a b. (a -> b) -> Sides a -> Sides b
Functor,Functor Sides
Foldable Sides
Functor Sides
-> Foldable Sides
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Sides a -> f (Sides b))
-> (forall (f :: * -> *) a.
Applicative f =>
Sides (f a) -> f (Sides a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Sides a -> m (Sides b))
-> (forall (m :: * -> *) a. Monad m => Sides (m a) -> m (Sides a))
-> Traversable Sides
(a -> f b) -> Sides a -> f (Sides b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Sides (m a) -> m (Sides a)
forall (f :: * -> *) a. Applicative f => Sides (f a) -> f (Sides a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Sides a -> m (Sides b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Sides a -> f (Sides b)
sequence :: Sides (m a) -> m (Sides a)
$csequence :: forall (m :: * -> *) a. Monad m => Sides (m a) -> m (Sides a)
mapM :: (a -> m b) -> Sides a -> m (Sides b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Sides a -> m (Sides b)
sequenceA :: Sides (f a) -> f (Sides a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Sides (f a) -> f (Sides a)
traverse :: (a -> f b) -> Sides a -> f (Sides b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Sides a -> f (Sides b)
$cp2Traversable :: Foldable Sides
$cp1Traversable :: Functor Sides
Traversable)
makeLenses ''Sides
instance Applicative Sides where
pure :: a -> Sides a
pure a
x = a -> a -> a -> a -> Sides a
forall a. a -> a -> a -> a -> Sides a
Sides a
x a
x a
x a
x
(Sides a -> b
f a -> b
g a -> b
h a -> b
i) <*> :: Sides (a -> b) -> Sides a -> Sides b
<*> (Sides a
a a
b a
c a
d) = b -> b -> b -> b -> Sides b
forall a. a -> a -> a -> a -> Sides a
Sides (a -> b
f a
a) (a -> b
g a
b) (a -> b
h a
c) (a -> b
i a
d)
instance Foldable1 Sides
instance Traversable1 Sides where
traverse1 :: (a -> f b) -> Sides a -> f (Sides b)
traverse1 a -> f b
f (Sides a
a a
b a
c a
d) = b -> b -> b -> b -> Sides b
forall a. a -> a -> a -> a -> Sides a
Sides (b -> b -> b -> b -> Sides b) -> f b -> f (b -> b -> b -> Sides b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> b -> b -> Sides b) -> f b -> f (b -> b -> Sides b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> f b
f a
b f (b -> b -> Sides b) -> f b -> f (b -> Sides b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> f b
f a
c f (b -> Sides b) -> f b -> f (Sides b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> f b
f a
d
instance Semigroup a => Semigroup (Sides a) where
Sides a
s <> :: Sides a -> Sides a -> Sides a
<> Sides a
s' = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> Sides a -> Sides (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sides a
s Sides (a -> a) -> Sides a -> Sides a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sides a
s'
instance Monoid a => Monoid (Sides a) where
mempty :: Sides a
mempty = a -> Sides a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
type instance Index (Sides a) = CardinalDirection
type instance IxValue (Sides a) = a
instance Ixed (Sides a) where
ix :: Index (Sides a) -> Traversal' (Sides a) (IxValue (Sides a))
ix = \case
Index (Sides a)
North -> (IxValue (Sides a) -> f (IxValue (Sides a)))
-> Sides a -> f (Sides a)
forall a. Lens' (Sides a) a
north
Index (Sides a)
East -> (IxValue (Sides a) -> f (IxValue (Sides a)))
-> Sides a -> f (Sides a)
forall a. Lens' (Sides a) a
east
Index (Sides a)
South -> (IxValue (Sides a) -> f (IxValue (Sides a)))
-> Sides a -> f (Sides a)
forall a. Lens' (Sides a) a
south
Index (Sides a)
West -> (IxValue (Sides a) -> f (IxValue (Sides a)))
-> Sides a -> f (Sides a)
forall a. Lens' (Sides a) a
west
sideDirections :: Sides CardinalDirection
sideDirections :: Sides CardinalDirection
sideDirections = CardinalDirection
-> CardinalDirection
-> CardinalDirection
-> CardinalDirection
-> Sides CardinalDirection
forall a. a -> a -> a -> a -> Sides a
Sides CardinalDirection
North CardinalDirection
East CardinalDirection
South CardinalDirection
West
topSide :: Num r => Rectangle p r -> LineSegment 2 p r
topSide :: Rectangle p r -> LineSegment 2 p r
topSide = (\(Corners Point 2 r :+ p
l Point 2 r :+ p
r Point 2 r :+ p
_ Point 2 r :+ p
_) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
l Point 2 r :+ p
r) (Corners (Point 2 r :+ p) -> LineSegment 2 p r)
-> (Rectangle p r -> Corners (Point 2 r :+ p))
-> Rectangle p r
-> LineSegment 2 p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle p r -> Corners (Point 2 r :+ p)
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners
bottomSide :: Num r => Rectangle p r -> LineSegment 2 p r
bottomSide :: Rectangle p r -> LineSegment 2 p r
bottomSide = (\(Corners Point 2 r :+ p
_ Point 2 r :+ p
_ Point 2 r :+ p
r Point 2 r :+ p
l) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
l Point 2 r :+ p
r) (Corners (Point 2 r :+ p) -> LineSegment 2 p r)
-> (Rectangle p r -> Corners (Point 2 r :+ p))
-> Rectangle p r
-> LineSegment 2 p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle p r -> Corners (Point 2 r :+ p)
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners
leftSide :: Num r => Rectangle p r -> LineSegment 2 p r
leftSide :: Rectangle p r -> LineSegment 2 p r
leftSide = (\(Corners Point 2 r :+ p
t Point 2 r :+ p
_ Point 2 r :+ p
_ Point 2 r :+ p
b) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
b Point 2 r :+ p
t) (Corners (Point 2 r :+ p) -> LineSegment 2 p r)
-> (Rectangle p r -> Corners (Point 2 r :+ p))
-> Rectangle p r
-> LineSegment 2 p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle p r -> Corners (Point 2 r :+ p)
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners
rightSide :: Num r => Rectangle p r -> LineSegment 2 p r
rightSide :: Rectangle p r -> LineSegment 2 p r
rightSide = (\(Corners Point 2 r :+ p
_ Point 2 r :+ p
t Point 2 r :+ p
b Point 2 r :+ p
_) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
b Point 2 r :+ p
t) (Corners (Point 2 r :+ p) -> LineSegment 2 p r)
-> (Rectangle p r -> Corners (Point 2 r :+ p))
-> Rectangle p r
-> LineSegment 2 p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle p r -> Corners (Point 2 r :+ p)
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners
sides :: Num r => Rectangle p r -> Sides (LineSegment 2 p r)
sides :: Rectangle p r -> Sides (LineSegment 2 p r)
sides Rectangle p r
r = let Corners Point 2 r :+ p
nw Point 2 r :+ p
ne Point 2 r :+ p
se Point 2 r :+ p
sw = Rectangle p r -> Corners (Point 2 r :+ p)
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners Rectangle p r
r
in LineSegment 2 p r
-> LineSegment 2 p r
-> LineSegment 2 p r
-> LineSegment 2 p r
-> Sides (LineSegment 2 p r)
forall a. a -> a -> a -> a -> Sides a
Sides ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
nw Point 2 r :+ p
ne) ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
ne Point 2 r :+ p
se)
((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
se Point 2 r :+ p
sw) ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
sw Point 2 r :+ p
nw)
sides' :: Num r => Rectangle p r -> Sides (LineSegment 2 p r)
sides' :: Rectangle p r -> Sides (LineSegment 2 p r)
sides' Rectangle p r
r = LineSegment 2 p r
-> LineSegment 2 p r
-> LineSegment 2 p r
-> LineSegment 2 p r
-> Sides (LineSegment 2 p r)
forall a. a -> a -> a -> a -> Sides a
Sides (Rectangle p r -> LineSegment 2 p r
forall r p. Num r => Rectangle p r -> LineSegment 2 p r
topSide Rectangle p r
r) (Rectangle p r -> LineSegment 2 p r
forall r p. Num r => Rectangle p r -> LineSegment 2 p r
rightSide Rectangle p r
r) (Rectangle p r -> LineSegment 2 p r
forall r p. Num r => Rectangle p r -> LineSegment 2 p r
bottomSide Rectangle p r
r) (Rectangle p r -> LineSegment 2 p r
forall r p. Num r => Rectangle p r -> LineSegment 2 p r
leftSide Rectangle p r
r)