{-# 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
    builder <- Acquire (Ptr MakeWire)
MakeWire.new
    traverse_ (liftIO . MakeWire.addWire builder <=< toAcquire . rawPath) paths
    MakeWire.wire 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