{-# LANGUAGE OverloadedStrings#-}
{-# LANGUAGE DeriveFunctor #-}

module Data.WKT.Triangle (module Data.WKT.Triangle) where
    
import Data.WKT.Classes
import Data.WKT.Point

import Data.List (intercalate)
import Data.Maybe (isJust)
import Data.Text (pack)
import Data.WKT.Helpers (allPairs)

newtype Triangle a  = Triangle [Point a]
    deriving ((forall a b. (a -> b) -> Triangle a -> Triangle b)
-> (forall a b. a -> Triangle b -> Triangle a) -> Functor Triangle
forall a b. a -> Triangle b -> Triangle a
forall a b. (a -> b) -> Triangle a -> Triangle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Triangle a -> Triangle b
fmap :: forall a b. (a -> b) -> Triangle a -> Triangle b
$c<$ :: forall a b. a -> Triangle b -> Triangle a
<$ :: forall a b. a -> Triangle b -> Triangle a
Functor, Triangle a -> Triangle a -> Bool
(Triangle a -> Triangle a -> Bool)
-> (Triangle a -> Triangle a -> Bool) -> Eq (Triangle a)
forall a. Eq a => Triangle a -> Triangle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Triangle a -> Triangle a -> Bool
== :: Triangle a -> Triangle a -> Bool
$c/= :: forall a. Eq a => Triangle a -> Triangle a -> Bool
/= :: Triangle a -> Triangle a -> Bool
Eq)

instance Show a => Show (Triangle a) where
    show :: Triangle a -> String
show (Triangle [Point a]
vertices) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (Point a -> String
forall a. Show a => a -> String
show (Point a -> String) -> [Point a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
vertices)

instance Show a => ToWKT (Triangle a) where
    toWKT :: Triangle a -> Text
toWKT Triangle a
triangle = Text
"Triangle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
zmString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Triangle a -> String
forall a. Show a => a -> String
show Triangle a
triangle) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        where
            Triangle [Point a]
vertices = Triangle a
triangle
            first :: Point a
first = [Point a] -> Point a
forall a. HasCallStack => [a] -> a
head [Point a]
vertices
            z' :: Maybe a
z' = Point a -> Maybe a
forall a. Point a -> Maybe a
z Point a
first
            m' :: Maybe a
m' = Point a -> Maybe a
forall a. Point a -> Maybe a
m Point a
first

            zmString :: Text
zmString
                |Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
z' Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m' = Text
" ZM "
                |Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
z' = Text
" Z "
                |Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m' = Text
" M "
                |Bool
otherwise = Text
" "

instance Eq a => Valid (Triangle a) where
    isValid :: Triangle a -> Bool
isValid (Triangle [Point a]
lines') = Point a
firstPoint Point a -> Point a -> Bool
forall a. Eq a => a -> a -> Bool
== Point a
lastPoint Bool -> Bool -> Bool
&& Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
        where
            firstPoint :: Point a
firstPoint = [Point a] -> Point a
forall a. HasCallStack => [a] -> a
head  [Point a]
lines'
            lastPoint :: Point a
lastPoint = [Point a] -> Point a
forall a. HasCallStack => [a] -> a
head [Point a]
lines'
            size :: Int
size = [Point a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point a]
lines'

-- Must be valid Triangle
allSides :: Triangle a-> [(Point a, Point a)]
allSides :: forall a. Triangle a -> [(Point a, Point a)]
allSides (Triangle [Point a]
vertices) = [Point a] -> [(Point a, Point a)]
forall a. [a] -> [(a, a)]
allPairs [Point a]
vertices