ArrangementSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module Data.Geometry.ArrangementSpec where

import           Control.Lens
import qualified Data.ByteString as B
import           Data.Ext
import           Data.Geometry
import           Data.Geometry.Arrangement
import           Data.Geometry.Arrangement.Draw
import           Data.Geometry.Ipe
import           Test.Hspec
import           Util(runOnFile)

spec :: Spec
spec = testCases "test/Data/Geometry/arrangement.ipe"


testCases    :: FilePath -> Spec
testCases fp = runIO (readInputFromFile fp) >>= \case
    Left e    -> it "reading arrangement file" $
                   expectationFailure $ "Failed to read ipe file " ++ show e
    Right tcs -> mapM_ toSpec tcs


--   ipeF <- beforeAll $ readInputFromFile "tests/Data/Geometry/pointInPolygon.ipe"
--   describe "Point in Polygon tests" $ do
--     it "returns the first element of a list" $ do
--       head [23 ..] `shouldBe` (23 :: Int)


data TestCase r = TestCase { _lines      :: [Line 2 r :+ ()]
                           , _outFile    :: FilePath -- ^ filename of the output arrangement,
                                                     -- as an ipe file
                           }
                  deriving (Show)

data Test = Test

drawArr    :: [Line 2 Rational :+ a] -> B.ByteString
drawArr ls = let arr = constructArrangement (Identity Test) ls
                 out = [ iO $ drawArrangement arr ]
                 Just bs = toIpeXML . singlePageFromContent $ out
             in bs


toSpec                       :: TestCase Rational -> Spec
toSpec (TestCase ls outFile) = do
    runOnFile "test drawing arrangement"  outFile (pure $ drawArr ls)

-- toSingleSpec poly r q = it msg $ (q `inPolygon` poly) `shouldBe` r
--   where
--     msg = "Point in polygon test with " ++ show q



-- toSpec (TestCase poly is bs os) = do
--                                     describe "inside tests" $
--                                       mapM_ (toSingleSpec poly Inside) is
--                                     describe "on boundary tests" $
--                                       mapM_ (toSingleSpec poly OnBoundary) bs
--                                     describe "outside tests" $
--                                       mapM_ (toSingleSpec poly Outside) os

readInputFromFile    :: FilePath -> IO (Either ConversionError [TestCase Rational])
readInputFromFile fp = fmap f <$> readSinglePageFile fp
  where
    f      :: IpePage Rational -> [TestCase Rational]
    f page = [ TestCase [ ext $ supportingLine s
                        | (s :+ _ats) <- segs
                        ]
                        (fp <> ".out.ipe")
             ]
      where
        segs = page^..content.traverse._withAttrs _IpePath _asLineSegment
    -- f page = [ TestCase poly
    --                     [ s^.symbolPoint | s <- myPoints ats, isInsidePt  s ]
    --                     [ s^.symbolPoint | s <- myPoints ats, isBorderPt  s ]
    --                     [ s^.symbolPoint | s <- myPoints ats, isOutsidePt s ]
    --          | (poly :+ ats) <- polies
    --          ]
    --   where
    --     polies = page^..content.traverse._withAttrs _IpePath _asSimplePolygon
    --     syms   = page^..content.traverse._IpeUse


    --     myPoints polyAts = [s | (s :+ ats) <- syms, belongsToPoly ats polyAts ]

    --     -- We test a point/polygon combination if they have the same color
    --     belongsToPoly symAts polyAts =
    --         lookupAttr colorP symAts == lookupAttr colorP polyAts

    --     -- A point i inside if it is a disk
    --     isInsidePt   :: IpeSymbol r -> Bool
    --     isInsidePt s = s^.symbolName == "mark/disk(sx)"

    --     -- Boxes are on the boundary
    --     isBorderPt s = s^.symbolName == "mark/box(sx)"

    --     -- crosses are outside the polygon
    --     isOutsidePt s = s^.symbolName == "mark/cross(sx)"

    --     colorP = Proxy :: Proxy Stroke