{-# LANGUAGE OverloadedStrings#-}

module Data.WKT.TIN (module Data.WKT.TIN) where

import Data.WKT.Classes
import Data.WKT.Triangle
import Data.List (intercalate, group, sort)
import Data.WKT.Point
import Data.WKT.Helpers (generateZMString)
import Data.Text (pack)

newtype TIN a = TIN [Triangle a]

instance Show a => Show (TIN a) where
    show :: TIN a -> String
show (TIN [Triangle a]
triangles) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
triangles'
        where
            triangles' :: [String]
triangles' = (Triangle a -> String) -> [Triangle a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Triangle [Point a]
triangle) -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> 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]
triangle) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") [Triangle a]
triangles

instance Show a => ToWKT (TIN a) where
    toWKT :: TIN a -> Text
toWKT (TIN [Triangle a]
triangles) = Text
"TIN" 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]
triangles) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        where
            (Triangle [Point a]
firstTriangle) = [Triangle a] -> Triangle a
forall a. HasCallStack => [a] -> a
head [Triangle a]
triangles
            first :: Point a
first = [Point a] -> Point a
forall a. HasCallStack => [a] -> a
head [Point a]
firstTriangle
            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 -> Maybe a -> Text
forall a. Maybe a -> Maybe a -> Text
generateZMString Maybe a
z' Maybe a
m'

instance Ord a => Valid (TIN a) where
    isValid :: TIN a -> Bool
isValid (TIN [Triangle a]
triangles) = Bool
validTriangles Bool -> Bool -> Bool
&& Bool
isContinuous
        where
            validTriangles :: Bool
validTriangles = (Triangle a -> Bool) -> [Triangle a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Triangle a -> Bool
forall a. Valid a => a -> Bool
isValid [Triangle a]
triangles
            allPoints :: [Point a]
allPoints = (Triangle a -> [Point a]) -> [Triangle a] -> [Point a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Triangle [Point a]
points) -> [Point a]
points) [Triangle a]
triangles
            isContinuous :: Bool
isContinuous =  Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Int
1 ([Int] -> Bool) -> [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ [Point a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Point a] -> Int) -> [[Point a]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a] -> [[Point a]]
forall a. Eq a => [a] -> [[a]]
group ([Point a] -> [Point a]
forall a. Ord a => [a] -> [a]
sort [Point a]
allPoints) -- checks if every point is on at least two sides.