module Graphics.Implicit.Export.Render.GetLoops (getLoops) where
import Prelude ((<$>), head, last, (==), Bool(False), (.), null, (<>), Eq, Maybe(Just, Nothing))
import Data.List (partition)
getLoops :: Eq a => [[a]] -> Maybe [[[a]]]
getLoops :: [[a]] -> Maybe [[[a]]]
getLoops [] = [[[a]]] -> Maybe [[[a]]]
forall a. a -> Maybe a
Just []
getLoops ([a]
a:[[a]]
as) = [[a]] -> [[a]] -> a -> Maybe [[[a]]]
forall a. Eq a => [[a]] -> [[a]] -> a -> Maybe [[[a]]]
getLoops' [[a]]
as [[a]
a] ([a] -> a
forall a. [a] -> a
last [a]
a)
getLoops'
:: Eq a
=> [[a]]
-> [[a]]
-> a
-> Maybe [[[a]]]
getLoops' :: [[a]] -> [[a]] -> a -> Maybe [[[a]]]
getLoops' [] [] a
_ = [[[a]]] -> Maybe [[[a]]]
forall a. a -> Maybe a
Just []
getLoops' ([a]
x:[[a]]
xs) [] a
_ = [[a]] -> [[a]] -> a -> Maybe [[[a]]]
forall a. Eq a => [[a]] -> [[a]] -> a -> Maybe [[[a]]]
getLoops' [[a]]
xs [[a]
x] ([a] -> a
forall a. [a] -> a
last [a]
x)
getLoops' [[a]]
segs [[a]]
workingLoop a
ultima | [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]
forall a. [a] -> a
head [[a]]
workingLoop) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ultima =
([[a]]
workingLoop [[a]] -> [[[a]]] -> [[[a]]]
forall a. a -> [a] -> [a]
:) ([[[a]]] -> [[[a]]]) -> Maybe [[[a]]] -> Maybe [[[a]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[a]] -> [[a]] -> a -> Maybe [[[a]]]
forall a. Eq a => [[a]] -> [[a]] -> a -> Maybe [[[a]]]
getLoops' [[a]]
segs [] a
ultima
getLoops' [[a]]
segs [[a]]
workingLoop a
ultima = do
let
presEnd :: [[a]] -> a
presEnd :: [[a]] -> a
presEnd = [a] -> a
forall a. [a] -> a
last ([a] -> a) -> ([[a]] -> [a]) -> [[a]] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. [a] -> a
last
connects :: [a] -> Bool
connects (a
x:[a]
_) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== [[a]] -> a
forall a. [[a]] -> a
presEnd [[a]]
workingLoop
connects [] = Bool
False
([[a]]
possibleConts, [[a]]
nonConts) = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition [a] -> Bool
connects [[a]]
segs
case [[a]]
possibleConts of
[] -> Maybe [[[a]]]
forall a. Maybe a
Nothing
([a]
next : [[a]]
conts) -> do
let unused :: [[a]]
unused = [[a]]
conts [[a]] -> [[a]] -> [[a]]
forall a. Semigroup a => a -> a -> a
<> [[a]]
nonConts
if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
next
then ([[a]]
workingLoop [[a]] -> [[[a]]] -> [[[a]]]
forall a. a -> [a] -> [a]
:) ([[[a]]] -> [[[a]]]) -> Maybe [[[a]]] -> Maybe [[[a]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[a]] -> [[a]] -> a -> Maybe [[[a]]]
forall a. Eq a => [[a]] -> [[a]] -> a -> Maybe [[[a]]]
getLoops' [[a]]
segs [] a
ultima
else [[a]] -> [[a]] -> a -> Maybe [[[a]]]
forall a. Eq a => [[a]] -> [[a]] -> a -> Maybe [[[a]]]
getLoops' [[a]]
unused ([[a]]
workingLoop [[a]] -> [[a]] -> [[a]]
forall a. Semigroup a => a -> a -> a
<> [[a]
next]) ([a] -> a
forall a. [a] -> a
last [a]
next)