packages feed

moonlight-triangulation-0.1.0.0: test/support/Support.hs

-- | Assertions shared by every test slice. Nothing here may depend on an
-- optional package flag, so that the minimal core configuration compiles the
-- same helpers the full configuration does.
module Support
  ( requireRight
  , requireQueryPoint
  , assertEqual
  , assertValid
  ) where

import Control.Monad (unless)
import Moonlight.Triangulation
  ( Point
  , QueryPoint
  , Triangulation
  , mkQueryPoint
  , validateTriangulation
  )

requireRight :: Show error => String -> Either error value -> IO value
requireRight label value = case value of
  Left failure -> fail (label <> ": " <> show failure)
  Right result -> pure result

requireQueryPoint :: String -> Point -> IO (QueryPoint)
requireQueryPoint label = requireRight label . mkQueryPoint

assertEqual :: (Eq value, Show value) => String -> value -> value -> IO ()
assertEqual label expected actual =
  unless (expected == actual) $
    fail (label <> ": expected " <> show expected <> ", got " <> show actual)

assertValid :: String -> Triangulation mode vertex directed undirected face -> IO ()
assertValid label triangulation =
  case validateTriangulation triangulation of
    [] -> pure ()
    violations -> fail (label <> " invariant violations: " <> show violations)