{-# OPTIONS_GHC -Wno-orphans #-}
module Util where
import Control.Monad
import Data.Bool
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import Data.Tuple.Extra
import Graphics.SvgTree
import Linear
applyWhen :: Bool -> (a -> a) -> a -> a
applyWhen :: forall a. Bool -> (a -> a) -> a -> a
applyWhen = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Bool -> a
bool forall a. a -> a
id
infixl 5 <<$>>
(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
<<$>> :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
(<<$>>) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
infixl 5 <<<$>>>
(<<<$>>>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
<<<$>>> :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a b.
(Functor f, Functor g, Functor h) =>
(a -> b) -> f (g (h a)) -> f (g (h b))
(<<<$>>>) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(++|) :: NonEmpty a -> [a] -> NonEmpty a
++| :: forall a. NonEmpty a -> [a] -> NonEmpty a
(++|) (a
x :| [a]
xs) [a]
ys = a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs forall a. [a] -> [a] -> [a]
++ [a]
ys
pairAdjacent :: [a] -> [(a, a)]
pairAdjacent :: forall a. [a] -> [(a, a)]
pairAdjacent [a]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [a]
xs
classifyOn :: Ord b => (a -> b) -> [a] -> [(b, NonEmpty a)]
classifyOn :: forall b a. Ord b => (a -> b) -> [a] -> [(b, NonEmpty a)]
classifyOn a -> b
f = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& forall (f :: * -> *) a. Applicative f => a -> f a
pure)
select :: [a] -> [(a, [a])]
select :: forall a. [a] -> [(a, [a])]
select [] = []
select (a
x : [a]
xs) = (a
x, [a]
xs) forall a. a -> [a] -> [a]
: ((a
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> forall a. [a] -> [(a, [a])]
select [a]
xs)
equivalentCycles :: NonEmpty a -> [NonEmpty a]
equivalentCycles :: forall a. NonEmpty a -> [NonEmpty a]
equivalentCycles = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. NonEmpty a -> [NonEmpty a]
refls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [NonEmpty a]
rots
where
refls :: NonEmpty a -> [NonEmpty a]
refls NonEmpty a
xs = [NonEmpty a
xs, forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty a
xs]
rots :: NonEmpty a -> [NonEmpty a]
rots = forall {a}. [a] -> NonEmpty a -> [NonEmpty a]
go []
go :: [a] -> NonEmpty a -> [NonEmpty a]
go [a]
ys = \case
a
x :| [a]
xs -> (a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs forall a. [a] -> [a] -> [a]
++ [a]
ys) forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([a] -> NonEmpty a -> [NonEmpty a]
go forall a b. (a -> b) -> a -> b
$ [a]
ys forall a. [a] -> [a] -> [a]
++ [a
x]) (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
xs)
intersectLines :: (Eq a, Ord a, Fractional a, Show a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
intersectLines :: forall a.
(Eq a, Ord a, Fractional a, Show a) =>
(V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
intersectLines (V2 a
x1 a
y1, V2 a
x2 a
y2) (V2 a
x3 a
y3, V2 a
x4 a
y4) = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ a
den forall a. Eq a => a -> a -> Bool
/= a
0
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ a
t forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
t forall a. Ord a => a -> a -> Bool
<= a
1
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ a
u forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
u forall a. Ord a => a -> a -> Bool
<= a
1
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
x a
y
where
dx12 :: a
dx12 = a
x1 forall a. Num a => a -> a -> a
- a
x2
dx13 :: a
dx13 = a
x1 forall a. Num a => a -> a -> a
- a
x3
dx34 :: a
dx34 = a
x3 forall a. Num a => a -> a -> a
- a
x4
dy12 :: a
dy12 = a
y1 forall a. Num a => a -> a -> a
- a
y2
dy13 :: a
dy13 = a
y1 forall a. Num a => a -> a -> a
- a
y3
dy34 :: a
dy34 = a
y3 forall a. Num a => a -> a -> a
- a
y4
den :: a
den = a
dx12 forall a. Num a => a -> a -> a
* a
dy34 forall a. Num a => a -> a -> a
- a
dy12 forall a. Num a => a -> a -> a
* a
dx34
u :: a
u = (a
dy12 forall a. Num a => a -> a -> a
* a
dx13 forall a. Num a => a -> a -> a
- a
dx12 forall a. Num a => a -> a -> a
* a
dy13) forall a. Fractional a => a -> a -> a
/ a
den
t :: a
t = (a
dx13 forall a. Num a => a -> a -> a
* a
dy34 forall a. Num a => a -> a -> a
- a
dy13 forall a. Num a => a -> a -> a
* a
dx34) forall a. Fractional a => a -> a -> a
/ a
den
x :: a
x = a
x1 forall a. Num a => a -> a -> a
- a
t forall a. Num a => a -> a -> a
* a
dx12
y :: a
y = a
y1 forall a. Num a => a -> a -> a
- a
t forall a. Num a => a -> a -> a
* a
dy12
pathBranch :: TreeBranch -> Maybe Path
pathBranch :: TreeBranch -> Maybe Path
pathBranch = \case
PathNode Path
p -> forall a. a -> Maybe a
Just Path
p
TreeBranch
_ -> forall a. Maybe a
Nothing
deriving instance Ord Cap
deriving instance Ord DrawAttributes
deriving instance Ord ElementRef
deriving instance Ord FillRule
deriving instance Ord FontStyle
deriving instance Ord LineJoin
deriving instance Ord Number
deriving instance Ord TextAnchor
deriving instance Ord Texture
deriving instance Ord Transformation
nearZeroNumber :: Number -> Bool
nearZeroNumber :: Number -> Bool
nearZeroNumber = \case
Num Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Px Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Em Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Percent Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Pc Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Mm Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Cm Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Point Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d
Inches Double
d -> forall a. Epsilon a => a -> Bool
nearZero Double
d