{-# LANGUAGE  InstanceSigs#-}
{-# OPTIONS_HADDOCK not-home #-}
module Waterfall.Internal.Path
( Path (..)
, joinPaths
, allPathEndpoints
) where

import Data.List.NonEmpty (NonEmpty ())
import Data.Foldable (toList)
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire) 
import Control.Monad.IO.Class (liftIO)
import qualified OpenCascade.TopoDS as TopoDS
import Foreign.Ptr
import Linear (V3 (..))
import Data.Semigroup (sconcat)
import Waterfall.Internal.Edges (allWireEndpoints, intersperseLines, joinWires)
-- | A Path in 3D Space 
--
-- Under the hood, this is represented by an OpenCascade `TopoDS.Wire`.
newtype Path = Path { Path -> Ptr Wire
rawPath :: Ptr TopoDS.Wire }

-- | Exposing this because I found it useful for debugging
allPathEndpoints :: Path -> [(V3 Double, V3 Double)]
allPathEndpoints :: Path -> [(V3 Double, V3 Double)]
allPathEndpoints (Path Ptr Wire
raw) = Acquire [(V3 Double, V3 Double)] -> [(V3 Double, V3 Double)]
forall a. Acquire a -> a
unsafeFromAcquire (Acquire [(V3 Double, V3 Double)] -> [(V3 Double, V3 Double)])
-> Acquire [(V3 Double, V3 Double)] -> [(V3 Double, V3 Double)]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Wire
wire <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
raw
    IO [(V3 Double, V3 Double)] -> Acquire [(V3 Double, V3 Double)]
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(V3 Double, V3 Double)] -> Acquire [(V3 Double, V3 Double)])
-> IO [(V3 Double, V3 Double)] -> Acquire [(V3 Double, V3 Double)]
forall a b. (a -> b) -> a -> b
$ Ptr Wire -> IO [(V3 Double, V3 Double)]
allWireEndpoints Ptr Wire
wire
    
joinPaths :: [Path] -> Path
joinPaths :: [Path] -> Path
joinPaths [Path]
paths = Ptr Wire -> Path
Path (Ptr Wire -> Path)
-> (Acquire (Ptr Wire) -> Ptr Wire) -> Acquire (Ptr Wire) -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Wire) -> Ptr Wire
forall a. Acquire a -> a
unsafeFromAcquire (Acquire (Ptr Wire) -> Path) -> Acquire (Ptr Wire) -> Path
forall a b. (a -> b) -> a -> b
$ do
    [Ptr Wire]
wires <- (Path -> Acquire (Ptr Wire)) -> [Path] -> Acquire [Ptr Wire]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire (Ptr Wire -> Acquire (Ptr Wire))
-> (Path -> Ptr Wire) -> Path -> Acquire (Ptr Wire)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Ptr Wire
rawPath) [Path]
paths
    [Ptr Wire] -> Acquire (Ptr Wire)
joinWires ([Ptr Wire] -> Acquire (Ptr Wire))
-> Acquire [Ptr Wire] -> Acquire (Ptr Wire)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Ptr Wire] -> Acquire [Ptr Wire]
intersperseLines [Ptr Wire]
wires

-- | Joins `Path`s, @ a <> b @ connects the end point of @ b @ to the start of @ b @, if these points are not coincident, a line is created between them.
-- 
-- Attempts to combine paths in ways that generate a non manifold path will produce an error case that is not currently handled gracefully.
instance Semigroup Path where
    sconcat :: NonEmpty Path -> Path
    sconcat :: NonEmpty Path -> Path
sconcat = [Path] -> Path
joinPaths ([Path] -> Path)
-> (NonEmpty Path -> [Path]) -> NonEmpty Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Path -> [Path]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (<>) :: Path -> Path -> Path
    Path
a <> :: Path -> Path -> Path
<> Path
b = [Path] -> Path
joinPaths [Path
a, Path
b]
    
instance Monoid Path where
    mempty :: Path
    mempty :: Path
mempty = [Path] -> Path
joinPaths []
    mconcat :: [Path] -> Path
    mconcat :: [Path] -> Path
mconcat = [Path] -> Path
joinPaths