moonlight-triangulation-1.4.0.3: test/public-components/Main.hs

module Main (main) where

import Data.Bifunctor (first)
import qualified Data.Vector as Vector
import Moonlight.Triangulation.BulkLoad (delaunayGeometry)
import Moonlight.Triangulation.Dcel (numVertices)
import Moonlight.Triangulation.FloodFillIterator
  ( RectangleMetricError
  , verticesInRectangle
  )
import Moonlight.Triangulation.Handles.Iterators.DynamicIterators
  ( vertexHandles
  )
import Moonlight.Triangulation.PointLocation (locatePoint)
import Moonlight.Triangulation.Session
  ( insertVertexAt
  , removeAt
  , withSession
  )
import Moonlight.Triangulation.Types
  ( BuildError
  , InsertionDisposition (Inserted)
  , Location (OnVertex)
  , Point (..)
  , PointValidationError
  )
import Moonlight.Triangulation.Math (mkQueryPoint)
import Moonlight.Triangulation.Validation (validateTriangulation)
import System.Exit (die)

data PublicComponentFailure
  = PublicBuildFailure !BuildError
  | PublicQueryFailure !PointValidationError
  | PublicRectangleFailure !RectangleMetricError
  deriving stock (Show)

data PublicComponentSummary = PublicComponentSummary
  { residentVertices :: !Int
  , owningVertexHandles :: !Int
  , rectangleVertices :: !Int
  , locatedResidentVertex :: !Bool
  , sessionInsertedVertex :: !Bool
  , sessionRemovedVertex :: !Bool
  , finalMeshValid :: !Bool
  }
  deriving stock (Eq, Show)

main :: IO ()
main =
  either
    (die . ("public component workflow refused: " <>) . show)
    assertExpected
    publicComponentWorkflow

publicComponentWorkflow :: Either PublicComponentFailure PublicComponentSummary
publicComponentWorkflow = do
  square <-
    first PublicBuildFailure
      ( delaunayGeometry
          ( Vector.fromList
              [ Point (-1) (-1)
              , Point 1 (-1)
              , Point 1 1
              , Point (-1) 1
              ]
          )
      )
  ((disposition, removed), restored, _) <-
    first PublicBuildFailure
      ( withSession square 1 $ do
          (_, inserted) <- insertVertexAt (Point 0 0) ()
          removal <- removeAt (Point 0 0)
          pure (inserted, removal)
      )
  query <- first PublicQueryFailure (mkQueryPoint (Point (-1) (-1)))
  inside <-
    first PublicRectangleFailure
      (verticesInRectangle restored (Point (-2) (-2)) (Point 2 2))
  pure
    PublicComponentSummary
      { residentVertices = numVertices restored
      , owningVertexHandles = length (vertexHandles restored)
      , rectangleVertices = length inside
      , locatedResidentVertex = case locatePoint restored query of
          OnVertex _ -> True
          _ -> False
      , sessionInsertedVertex = disposition == Inserted
      , sessionRemovedVertex = maybe False (const True) removed
      , finalMeshValid = null (validateTriangulation restored)
      }

assertExpected :: PublicComponentSummary -> IO ()
assertExpected actual
  | actual == expected = putStrLn "public components: ok"
  | otherwise =
      die
        ( "public component summary mismatch; expected "
            <> show expected
            <> ", got "
            <> show actual
        )
 where
  expected =
    PublicComponentSummary
      { residentVertices = 4
      , owningVertexHandles = 4
      , rectangleVertices = 4
      , locatedResidentVertex = True
      , sessionInsertedVertex = True
      , sessionRemovedVertex = True
      , finalMeshValid = True
      }