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

import Data.List.NonEmpty (NonEmpty ())
import Data.Foldable (traverse_, toList)
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire) 
import Control.Monad ((<=<))
import Control.Monad.IO.Class (liftIO)
import qualified OpenCascade.TopoDS as TopoDS
import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire
import Foreign.Ptr
import Data.Semigroup (sconcat)

-- | 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 }

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 MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
    (Path -> Acquire ()) -> [Path] -> Acquire ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ())
-> (Ptr Wire -> IO ()) -> Ptr Wire -> Acquire ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr MakeWire -> Ptr Wire -> IO ()
MakeWire.addWire Ptr MakeWire
builder (Ptr Wire -> Acquire ())
-> (Path -> Acquire (Ptr Wire)) -> Path -> Acquire ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder

-- | The Semigroup for `Path` attempts to join two paths that share a common endpoint.
--
-- Attempts to combine paths that do not share a common endpoint currently in 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