{-# LANGUAGE OverloadedStrings#-}
module Data.WKT.PolyhedralSurface (module Data.WKT.PolyhedralSurface) 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 PolyhedralSurface a = PolyhedralSurface [Triangle a]

instance Show a => Show (PolyhedralSurface a) where
    show :: PolyhedralSurface a -> String
show (PolyhedralSurface [Triangle a]
surface) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
surface'
        where
            surface' :: [String]
surface' = (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]
surface

instance Show a => ToWKT (PolyhedralSurface a) where
    toWKT :: PolyhedralSurface a -> Text
toWKT (PolyhedralSurface [Triangle a]
surface) = Text
"PolyhedralSurface" 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]
surface) 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]
surface
            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 (PolyhedralSurface a) where
    isValid :: PolyhedralSurface a -> Bool
isValid (PolyhedralSurface [Triangle a]
surfaces) = Bool
valid -- checks if every side has two triangles associated to it.
        where
            sides :: [[(Point a, Point a)]]
sides = [(Point a, Point a)] -> [[(Point a, Point a)]]
forall a. Eq a => [a] -> [[a]]
group ([(Point a, Point a)] -> [[(Point a, Point a)]])
-> [(Point a, Point a)] -> [[(Point a, Point a)]]
forall a b. (a -> b) -> a -> b
$ [(Point a, Point a)] -> [(Point a, Point a)]
forall a. Ord a => [a] -> [a]
sort ([(Point a, Point a)] -> [(Point a, Point a)])
-> [(Point a, Point a)] -> [(Point a, Point a)]
forall a b. (a -> b) -> a -> b
$ (Triangle a -> [(Point a, Point a)])
-> [Triangle a] -> [(Point a, Point a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Triangle a -> [(Point a, Point a)]
forall a. Triangle a -> [(Point a, Point a)]
allSides [Triangle a]
surfaces
            valid :: Bool
valid =  ([(Point a, Point a)] -> Bool) -> [[(Point a, Point a)]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
2) (Int -> Bool)
-> ([(Point a, Point a)] -> Int) -> [(Point a, Point a)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Point a, Point a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[(Point a, Point a)]]
sides