{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.PlnarSubdivision.Raw
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  The 'Raw' building block used in a Planar Subdivision
--
--------------------------------------------------------------------------------
module Data.Geometry.PlanarSubdivision.Raw where

import           Control.Lens
import           Data.Aeson
import           Data.PlaneGraph (FaceId', Dart)
import qualified Data.Sequence as Seq
import           GHC.Generics (Generic)

--------------------------------------------------------------------------------

-- | Helper data type and type family to Wrap a proxy type.
data Wrap' s
type family Wrap (s :: k) :: k where
  Wrap s = Wrap' s

-- | ComponentId type
newtype ComponentId s = ComponentId { ComponentId s -> Int
unCI :: Int }
  deriving (Int -> ComponentId s -> ShowS
[ComponentId s] -> ShowS
ComponentId s -> String
(Int -> ComponentId s -> ShowS)
-> (ComponentId s -> String)
-> ([ComponentId s] -> ShowS)
-> Show (ComponentId s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k). Int -> ComponentId s -> ShowS
forall k (s :: k). [ComponentId s] -> ShowS
forall k (s :: k). ComponentId s -> String
showList :: [ComponentId s] -> ShowS
$cshowList :: forall k (s :: k). [ComponentId s] -> ShowS
show :: ComponentId s -> String
$cshow :: forall k (s :: k). ComponentId s -> String
showsPrec :: Int -> ComponentId s -> ShowS
$cshowsPrec :: forall k (s :: k). Int -> ComponentId s -> ShowS
Show,ComponentId s -> ComponentId s -> Bool
(ComponentId s -> ComponentId s -> Bool)
-> (ComponentId s -> ComponentId s -> Bool) -> Eq (ComponentId s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k). ComponentId s -> ComponentId s -> Bool
/= :: ComponentId s -> ComponentId s -> Bool
$c/= :: forall k (s :: k). ComponentId s -> ComponentId s -> Bool
== :: ComponentId s -> ComponentId s -> Bool
$c== :: forall k (s :: k). ComponentId s -> ComponentId s -> Bool
Eq,Eq (ComponentId s)
Eq (ComponentId s)
-> (ComponentId s -> ComponentId s -> Ordering)
-> (ComponentId s -> ComponentId s -> Bool)
-> (ComponentId s -> ComponentId s -> Bool)
-> (ComponentId s -> ComponentId s -> Bool)
-> (ComponentId s -> ComponentId s -> Bool)
-> (ComponentId s -> ComponentId s -> ComponentId s)
-> (ComponentId s -> ComponentId s -> ComponentId s)
-> Ord (ComponentId s)
ComponentId s -> ComponentId s -> Bool
ComponentId s -> ComponentId s -> Ordering
ComponentId s -> ComponentId s -> ComponentId s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k). Eq (ComponentId s)
forall k (s :: k). ComponentId s -> ComponentId s -> Bool
forall k (s :: k). ComponentId s -> ComponentId s -> Ordering
forall k (s :: k). ComponentId s -> ComponentId s -> ComponentId s
min :: ComponentId s -> ComponentId s -> ComponentId s
$cmin :: forall k (s :: k). ComponentId s -> ComponentId s -> ComponentId s
max :: ComponentId s -> ComponentId s -> ComponentId s
$cmax :: forall k (s :: k). ComponentId s -> ComponentId s -> ComponentId s
>= :: ComponentId s -> ComponentId s -> Bool
$c>= :: forall k (s :: k). ComponentId s -> ComponentId s -> Bool
> :: ComponentId s -> ComponentId s -> Bool
$c> :: forall k (s :: k). ComponentId s -> ComponentId s -> Bool
<= :: ComponentId s -> ComponentId s -> Bool
$c<= :: forall k (s :: k). ComponentId s -> ComponentId s -> Bool
< :: ComponentId s -> ComponentId s -> Bool
$c< :: forall k (s :: k). ComponentId s -> ComponentId s -> Bool
compare :: ComponentId s -> ComponentId s -> Ordering
$ccompare :: forall k (s :: k). ComponentId s -> ComponentId s -> Ordering
$cp1Ord :: forall k (s :: k). Eq (ComponentId s)
Ord,(forall x. ComponentId s -> Rep (ComponentId s) x)
-> (forall x. Rep (ComponentId s) x -> ComponentId s)
-> Generic (ComponentId s)
forall x. Rep (ComponentId s) x -> ComponentId s
forall x. ComponentId s -> Rep (ComponentId s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (s :: k) x. Rep (ComponentId s) x -> ComponentId s
forall k (s :: k) x. ComponentId s -> Rep (ComponentId s) x
$cto :: forall k (s :: k) x. Rep (ComponentId s) x -> ComponentId s
$cfrom :: forall k (s :: k) x. ComponentId s -> Rep (ComponentId s) x
Generic,ComponentId s
ComponentId s -> ComponentId s -> Bounded (ComponentId s)
forall a. a -> a -> Bounded a
forall k (s :: k). ComponentId s
maxBound :: ComponentId s
$cmaxBound :: forall k (s :: k). ComponentId s
minBound :: ComponentId s
$cminBound :: forall k (s :: k). ComponentId s
Bounded,Int -> ComponentId s
ComponentId s -> Int
ComponentId s -> [ComponentId s]
ComponentId s -> ComponentId s
ComponentId s -> ComponentId s -> [ComponentId s]
ComponentId s -> ComponentId s -> ComponentId s -> [ComponentId s]
(ComponentId s -> ComponentId s)
-> (ComponentId s -> ComponentId s)
-> (Int -> ComponentId s)
-> (ComponentId s -> Int)
-> (ComponentId s -> [ComponentId s])
-> (ComponentId s -> ComponentId s -> [ComponentId s])
-> (ComponentId s -> ComponentId s -> [ComponentId s])
-> (ComponentId s
    -> ComponentId s -> ComponentId s -> [ComponentId s])
-> Enum (ComponentId s)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall k (s :: k). Int -> ComponentId s
forall k (s :: k). ComponentId s -> Int
forall k (s :: k). ComponentId s -> [ComponentId s]
forall k (s :: k). ComponentId s -> ComponentId s
forall k (s :: k).
ComponentId s -> ComponentId s -> [ComponentId s]
forall k (s :: k).
ComponentId s -> ComponentId s -> ComponentId s -> [ComponentId s]
enumFromThenTo :: ComponentId s -> ComponentId s -> ComponentId s -> [ComponentId s]
$cenumFromThenTo :: forall k (s :: k).
ComponentId s -> ComponentId s -> ComponentId s -> [ComponentId s]
enumFromTo :: ComponentId s -> ComponentId s -> [ComponentId s]
$cenumFromTo :: forall k (s :: k).
ComponentId s -> ComponentId s -> [ComponentId s]
enumFromThen :: ComponentId s -> ComponentId s -> [ComponentId s]
$cenumFromThen :: forall k (s :: k).
ComponentId s -> ComponentId s -> [ComponentId s]
enumFrom :: ComponentId s -> [ComponentId s]
$cenumFrom :: forall k (s :: k). ComponentId s -> [ComponentId s]
fromEnum :: ComponentId s -> Int
$cfromEnum :: forall k (s :: k). ComponentId s -> Int
toEnum :: Int -> ComponentId s
$ctoEnum :: forall k (s :: k). Int -> ComponentId s
pred :: ComponentId s -> ComponentId s
$cpred :: forall k (s :: k). ComponentId s -> ComponentId s
succ :: ComponentId s -> ComponentId s
$csucc :: forall k (s :: k). ComponentId s -> ComponentId s
Enum,[ComponentId s] -> Encoding
[ComponentId s] -> Value
ComponentId s -> Encoding
ComponentId s -> Value
(ComponentId s -> Value)
-> (ComponentId s -> Encoding)
-> ([ComponentId s] -> Value)
-> ([ComponentId s] -> Encoding)
-> ToJSON (ComponentId s)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall k (s :: k). [ComponentId s] -> Encoding
forall k (s :: k). [ComponentId s] -> Value
forall k (s :: k). ComponentId s -> Encoding
forall k (s :: k). ComponentId s -> Value
toEncodingList :: [ComponentId s] -> Encoding
$ctoEncodingList :: forall k (s :: k). [ComponentId s] -> Encoding
toJSONList :: [ComponentId s] -> Value
$ctoJSONList :: forall k (s :: k). [ComponentId s] -> Value
toEncoding :: ComponentId s -> Encoding
$ctoEncoding :: forall k (s :: k). ComponentId s -> Encoding
toJSON :: ComponentId s -> Value
$ctoJSON :: forall k (s :: k). ComponentId s -> Value
ToJSON,Value -> Parser [ComponentId s]
Value -> Parser (ComponentId s)
(Value -> Parser (ComponentId s))
-> (Value -> Parser [ComponentId s]) -> FromJSON (ComponentId s)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall k (s :: k). Value -> Parser [ComponentId s]
forall k (s :: k). Value -> Parser (ComponentId s)
parseJSONList :: Value -> Parser [ComponentId s]
$cparseJSONList :: forall k (s :: k). Value -> Parser [ComponentId s]
parseJSON :: Value -> Parser (ComponentId s)
$cparseJSON :: forall k (s :: k). Value -> Parser (ComponentId s)
FromJSON)

--------------------------------------------------------------------------------

-- | Helper type for the data that we store in a planar subdivision
data Raw s ia a = Raw { Raw s ia a -> ComponentId s
_compId  :: !(ComponentId s)
                      , Raw s ia a -> ia
_idxVal  :: !ia
                      , Raw s ia a -> a
_dataVal :: !a
                      } deriving (Raw s ia a -> Raw s ia a -> Bool
(Raw s ia a -> Raw s ia a -> Bool)
-> (Raw s ia a -> Raw s ia a -> Bool) -> Eq (Raw s ia a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k) ia a.
(Eq ia, Eq a) =>
Raw s ia a -> Raw s ia a -> Bool
/= :: Raw s ia a -> Raw s ia a -> Bool
$c/= :: forall k (s :: k) ia a.
(Eq ia, Eq a) =>
Raw s ia a -> Raw s ia a -> Bool
== :: Raw s ia a -> Raw s ia a -> Bool
$c== :: forall k (s :: k) ia a.
(Eq ia, Eq a) =>
Raw s ia a -> Raw s ia a -> Bool
Eq,Int -> Raw s ia a -> ShowS
[Raw s ia a] -> ShowS
Raw s ia a -> String
(Int -> Raw s ia a -> ShowS)
-> (Raw s ia a -> String)
-> ([Raw s ia a] -> ShowS)
-> Show (Raw s ia a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) ia a.
(Show ia, Show a) =>
Int -> Raw s ia a -> ShowS
forall k (s :: k) ia a. (Show ia, Show a) => [Raw s ia a] -> ShowS
forall k (s :: k) ia a. (Show ia, Show a) => Raw s ia a -> String
showList :: [Raw s ia a] -> ShowS
$cshowList :: forall k (s :: k) ia a. (Show ia, Show a) => [Raw s ia a] -> ShowS
show :: Raw s ia a -> String
$cshow :: forall k (s :: k) ia a. (Show ia, Show a) => Raw s ia a -> String
showsPrec :: Int -> Raw s ia a -> ShowS
$cshowsPrec :: forall k (s :: k) ia a.
(Show ia, Show a) =>
Int -> Raw s ia a -> ShowS
Show,a -> Raw s ia b -> Raw s ia a
(a -> b) -> Raw s ia a -> Raw s ia b
(forall a b. (a -> b) -> Raw s ia a -> Raw s ia b)
-> (forall a b. a -> Raw s ia b -> Raw s ia a)
-> Functor (Raw s ia)
forall k (s :: k) ia a b. a -> Raw s ia b -> Raw s ia a
forall k (s :: k) ia a b. (a -> b) -> Raw s ia a -> Raw s ia b
forall a b. a -> Raw s ia b -> Raw s ia a
forall a b. (a -> b) -> Raw s ia a -> Raw s ia b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Raw s ia b -> Raw s ia a
$c<$ :: forall k (s :: k) ia a b. a -> Raw s ia b -> Raw s ia a
fmap :: (a -> b) -> Raw s ia a -> Raw s ia b
$cfmap :: forall k (s :: k) ia a b. (a -> b) -> Raw s ia a -> Raw s ia b
Functor,Raw s ia a -> Bool
(a -> m) -> Raw s ia a -> m
(a -> b -> b) -> b -> Raw s ia a -> b
(forall m. Monoid m => Raw s ia m -> m)
-> (forall m a. Monoid m => (a -> m) -> Raw s ia a -> m)
-> (forall m a. Monoid m => (a -> m) -> Raw s ia a -> m)
-> (forall a b. (a -> b -> b) -> b -> Raw s ia a -> b)
-> (forall a b. (a -> b -> b) -> b -> Raw s ia a -> b)
-> (forall b a. (b -> a -> b) -> b -> Raw s ia a -> b)
-> (forall b a. (b -> a -> b) -> b -> Raw s ia a -> b)
-> (forall a. (a -> a -> a) -> Raw s ia a -> a)
-> (forall a. (a -> a -> a) -> Raw s ia a -> a)
-> (forall a. Raw s ia a -> [a])
-> (forall a. Raw s ia a -> Bool)
-> (forall a. Raw s ia a -> Int)
-> (forall a. Eq a => a -> Raw s ia a -> Bool)
-> (forall a. Ord a => Raw s ia a -> a)
-> (forall a. Ord a => Raw s ia a -> a)
-> (forall a. Num a => Raw s ia a -> a)
-> (forall a. Num a => Raw s ia a -> a)
-> Foldable (Raw s ia)
forall a. Eq a => a -> Raw s ia a -> Bool
forall a. Num a => Raw s ia a -> a
forall a. Ord a => Raw s ia a -> a
forall m. Monoid m => Raw s ia m -> m
forall a. Raw s ia a -> Bool
forall a. Raw s ia a -> Int
forall a. Raw s ia a -> [a]
forall a. (a -> a -> a) -> Raw s ia a -> a
forall k (s :: k) ia a. Eq a => a -> Raw s ia a -> Bool
forall k (s :: k) ia a. Num a => Raw s ia a -> a
forall k (s :: k) ia a. Ord a => Raw s ia a -> a
forall k (s :: k) ia m. Monoid m => Raw s ia m -> m
forall k (s :: k) ia a. Raw s ia a -> Bool
forall k (s :: k) ia a. Raw s ia a -> Int
forall k (s :: k) ia a. Raw s ia a -> [a]
forall k (s :: k) ia a. (a -> a -> a) -> Raw s ia a -> a
forall k (s :: k) ia m a. Monoid m => (a -> m) -> Raw s ia a -> m
forall k (s :: k) ia b a. (b -> a -> b) -> b -> Raw s ia a -> b
forall k (s :: k) ia a b. (a -> b -> b) -> b -> Raw s ia a -> b
forall m a. Monoid m => (a -> m) -> Raw s ia a -> m
forall b a. (b -> a -> b) -> b -> Raw s ia a -> b
forall a b. (a -> b -> b) -> b -> Raw s ia a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Raw s ia a -> a
$cproduct :: forall k (s :: k) ia a. Num a => Raw s ia a -> a
sum :: Raw s ia a -> a
$csum :: forall k (s :: k) ia a. Num a => Raw s ia a -> a
minimum :: Raw s ia a -> a
$cminimum :: forall k (s :: k) ia a. Ord a => Raw s ia a -> a
maximum :: Raw s ia a -> a
$cmaximum :: forall k (s :: k) ia a. Ord a => Raw s ia a -> a
elem :: a -> Raw s ia a -> Bool
$celem :: forall k (s :: k) ia a. Eq a => a -> Raw s ia a -> Bool
length :: Raw s ia a -> Int
$clength :: forall k (s :: k) ia a. Raw s ia a -> Int
null :: Raw s ia a -> Bool
$cnull :: forall k (s :: k) ia a. Raw s ia a -> Bool
toList :: Raw s ia a -> [a]
$ctoList :: forall k (s :: k) ia a. Raw s ia a -> [a]
foldl1 :: (a -> a -> a) -> Raw s ia a -> a
$cfoldl1 :: forall k (s :: k) ia a. (a -> a -> a) -> Raw s ia a -> a
foldr1 :: (a -> a -> a) -> Raw s ia a -> a
$cfoldr1 :: forall k (s :: k) ia a. (a -> a -> a) -> Raw s ia a -> a
foldl' :: (b -> a -> b) -> b -> Raw s ia a -> b
$cfoldl' :: forall k (s :: k) ia b a. (b -> a -> b) -> b -> Raw s ia a -> b
foldl :: (b -> a -> b) -> b -> Raw s ia a -> b
$cfoldl :: forall k (s :: k) ia b a. (b -> a -> b) -> b -> Raw s ia a -> b
foldr' :: (a -> b -> b) -> b -> Raw s ia a -> b
$cfoldr' :: forall k (s :: k) ia a b. (a -> b -> b) -> b -> Raw s ia a -> b
foldr :: (a -> b -> b) -> b -> Raw s ia a -> b
$cfoldr :: forall k (s :: k) ia a b. (a -> b -> b) -> b -> Raw s ia a -> b
foldMap' :: (a -> m) -> Raw s ia a -> m
$cfoldMap' :: forall k (s :: k) ia m a. Monoid m => (a -> m) -> Raw s ia a -> m
foldMap :: (a -> m) -> Raw s ia a -> m
$cfoldMap :: forall k (s :: k) ia m a. Monoid m => (a -> m) -> Raw s ia a -> m
fold :: Raw s ia m -> m
$cfold :: forall k (s :: k) ia m. Monoid m => Raw s ia m -> m
Foldable,Functor (Raw s ia)
Foldable (Raw s ia)
Functor (Raw s ia)
-> Foldable (Raw s ia)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Raw s ia a -> f (Raw s ia b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Raw s ia (f a) -> f (Raw s ia a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Raw s ia a -> m (Raw s ia b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Raw s ia (m a) -> m (Raw s ia a))
-> Traversable (Raw s ia)
(a -> f b) -> Raw s ia a -> f (Raw s ia b)
forall k (s :: k) ia. Functor (Raw s ia)
forall k (s :: k) ia. Foldable (Raw s ia)
forall k (s :: k) ia (m :: * -> *) a.
Monad m =>
Raw s ia (m a) -> m (Raw s ia a)
forall k (s :: k) ia (f :: * -> *) a.
Applicative f =>
Raw s ia (f a) -> f (Raw s ia a)
forall k (s :: k) ia (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Raw s ia a -> m (Raw s ia b)
forall k (s :: k) ia (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Raw s ia a -> f (Raw s ia b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Raw s ia (m a) -> m (Raw s ia a)
forall (f :: * -> *) a.
Applicative f =>
Raw s ia (f a) -> f (Raw s ia a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Raw s ia a -> m (Raw s ia b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Raw s ia a -> f (Raw s ia b)
sequence :: Raw s ia (m a) -> m (Raw s ia a)
$csequence :: forall k (s :: k) ia (m :: * -> *) a.
Monad m =>
Raw s ia (m a) -> m (Raw s ia a)
mapM :: (a -> m b) -> Raw s ia a -> m (Raw s ia b)
$cmapM :: forall k (s :: k) ia (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Raw s ia a -> m (Raw s ia b)
sequenceA :: Raw s ia (f a) -> f (Raw s ia a)
$csequenceA :: forall k (s :: k) ia (f :: * -> *) a.
Applicative f =>
Raw s ia (f a) -> f (Raw s ia a)
traverse :: (a -> f b) -> Raw s ia a -> f (Raw s ia b)
$ctraverse :: forall k (s :: k) ia (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Raw s ia a -> f (Raw s ia b)
$cp2Traversable :: forall k (s :: k) ia. Foldable (Raw s ia)
$cp1Traversable :: forall k (s :: k) ia. Functor (Raw s ia)
Traversable,(forall x. Raw s ia a -> Rep (Raw s ia a) x)
-> (forall x. Rep (Raw s ia a) x -> Raw s ia a)
-> Generic (Raw s ia a)
forall x. Rep (Raw s ia a) x -> Raw s ia a
forall x. Raw s ia a -> Rep (Raw s ia a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (s :: k) ia a x. Rep (Raw s ia a) x -> Raw s ia a
forall k (s :: k) ia a x. Raw s ia a -> Rep (Raw s ia a) x
$cto :: forall k (s :: k) ia a x. Rep (Raw s ia a) x -> Raw s ia a
$cfrom :: forall k (s :: k) ia a x. Raw s ia a -> Rep (Raw s ia a) x
Generic)

instance (FromJSON ia, FromJSON a) => FromJSON (Raw s ia a)
instance (ToJSON ia, ToJSON a) => ToJSON (Raw s ia a) where
  toEncoding :: Raw s ia a -> Encoding
toEncoding = Options -> Raw s ia a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | get the dataVal of a Raw
dataVal :: Lens (Raw s ia a) (Raw s ia b) a b
dataVal :: (a -> f b) -> Raw s ia a -> f (Raw s ia b)
dataVal = (Raw s ia a -> a)
-> (Raw s ia a -> b -> Raw s ia b)
-> Lens (Raw s ia a) (Raw s ia b) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Raw ComponentId s
_ ia
_ a
x) -> a
x) (\(Raw ComponentId s
c ia
i a
_) b
y -> ComponentId s -> ia -> b -> Raw s ia b
forall k (s :: k) ia a. ComponentId s -> ia -> a -> Raw s ia a
Raw ComponentId s
c ia
i b
y)

--------------------------------------------------------------------------------

-- | The Face data consists of the data itself and a list of holes
data FaceData h f = FaceData { FaceData h f -> Seq h
_holes :: Seq.Seq h
                             , FaceData h f -> f
_fData :: !f
                             } deriving (Int -> FaceData h f -> ShowS
[FaceData h f] -> ShowS
FaceData h f -> String
(Int -> FaceData h f -> ShowS)
-> (FaceData h f -> String)
-> ([FaceData h f] -> ShowS)
-> Show (FaceData h f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall h f. (Show h, Show f) => Int -> FaceData h f -> ShowS
forall h f. (Show h, Show f) => [FaceData h f] -> ShowS
forall h f. (Show h, Show f) => FaceData h f -> String
showList :: [FaceData h f] -> ShowS
$cshowList :: forall h f. (Show h, Show f) => [FaceData h f] -> ShowS
show :: FaceData h f -> String
$cshow :: forall h f. (Show h, Show f) => FaceData h f -> String
showsPrec :: Int -> FaceData h f -> ShowS
$cshowsPrec :: forall h f. (Show h, Show f) => Int -> FaceData h f -> ShowS
Show,FaceData h f -> FaceData h f -> Bool
(FaceData h f -> FaceData h f -> Bool)
-> (FaceData h f -> FaceData h f -> Bool) -> Eq (FaceData h f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall h f. (Eq h, Eq f) => FaceData h f -> FaceData h f -> Bool
/= :: FaceData h f -> FaceData h f -> Bool
$c/= :: forall h f. (Eq h, Eq f) => FaceData h f -> FaceData h f -> Bool
== :: FaceData h f -> FaceData h f -> Bool
$c== :: forall h f. (Eq h, Eq f) => FaceData h f -> FaceData h f -> Bool
Eq,Eq (FaceData h f)
Eq (FaceData h f)
-> (FaceData h f -> FaceData h f -> Ordering)
-> (FaceData h f -> FaceData h f -> Bool)
-> (FaceData h f -> FaceData h f -> Bool)
-> (FaceData h f -> FaceData h f -> Bool)
-> (FaceData h f -> FaceData h f -> Bool)
-> (FaceData h f -> FaceData h f -> FaceData h f)
-> (FaceData h f -> FaceData h f -> FaceData h f)
-> Ord (FaceData h f)
FaceData h f -> FaceData h f -> Bool
FaceData h f -> FaceData h f -> Ordering
FaceData h f -> FaceData h f -> FaceData h f
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall h f. (Ord h, Ord f) => Eq (FaceData h f)
forall h f. (Ord h, Ord f) => FaceData h f -> FaceData h f -> Bool
forall h f.
(Ord h, Ord f) =>
FaceData h f -> FaceData h f -> Ordering
forall h f.
(Ord h, Ord f) =>
FaceData h f -> FaceData h f -> FaceData h f
min :: FaceData h f -> FaceData h f -> FaceData h f
$cmin :: forall h f.
(Ord h, Ord f) =>
FaceData h f -> FaceData h f -> FaceData h f
max :: FaceData h f -> FaceData h f -> FaceData h f
$cmax :: forall h f.
(Ord h, Ord f) =>
FaceData h f -> FaceData h f -> FaceData h f
>= :: FaceData h f -> FaceData h f -> Bool
$c>= :: forall h f. (Ord h, Ord f) => FaceData h f -> FaceData h f -> Bool
> :: FaceData h f -> FaceData h f -> Bool
$c> :: forall h f. (Ord h, Ord f) => FaceData h f -> FaceData h f -> Bool
<= :: FaceData h f -> FaceData h f -> Bool
$c<= :: forall h f. (Ord h, Ord f) => FaceData h f -> FaceData h f -> Bool
< :: FaceData h f -> FaceData h f -> Bool
$c< :: forall h f. (Ord h, Ord f) => FaceData h f -> FaceData h f -> Bool
compare :: FaceData h f -> FaceData h f -> Ordering
$ccompare :: forall h f.
(Ord h, Ord f) =>
FaceData h f -> FaceData h f -> Ordering
$cp1Ord :: forall h f. (Ord h, Ord f) => Eq (FaceData h f)
Ord,a -> FaceData h b -> FaceData h a
(a -> b) -> FaceData h a -> FaceData h b
(forall a b. (a -> b) -> FaceData h a -> FaceData h b)
-> (forall a b. a -> FaceData h b -> FaceData h a)
-> Functor (FaceData h)
forall a b. a -> FaceData h b -> FaceData h a
forall a b. (a -> b) -> FaceData h a -> FaceData h b
forall h a b. a -> FaceData h b -> FaceData h a
forall h a b. (a -> b) -> FaceData h a -> FaceData h b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FaceData h b -> FaceData h a
$c<$ :: forall h a b. a -> FaceData h b -> FaceData h a
fmap :: (a -> b) -> FaceData h a -> FaceData h b
$cfmap :: forall h a b. (a -> b) -> FaceData h a -> FaceData h b
Functor,FaceData h a -> Bool
(a -> m) -> FaceData h a -> m
(a -> b -> b) -> b -> FaceData h a -> b
(forall m. Monoid m => FaceData h m -> m)
-> (forall m a. Monoid m => (a -> m) -> FaceData h a -> m)
-> (forall m a. Monoid m => (a -> m) -> FaceData h a -> m)
-> (forall a b. (a -> b -> b) -> b -> FaceData h a -> b)
-> (forall a b. (a -> b -> b) -> b -> FaceData h a -> b)
-> (forall b a. (b -> a -> b) -> b -> FaceData h a -> b)
-> (forall b a. (b -> a -> b) -> b -> FaceData h a -> b)
-> (forall a. (a -> a -> a) -> FaceData h a -> a)
-> (forall a. (a -> a -> a) -> FaceData h a -> a)
-> (forall a. FaceData h a -> [a])
-> (forall a. FaceData h a -> Bool)
-> (forall a. FaceData h a -> Int)
-> (forall a. Eq a => a -> FaceData h a -> Bool)
-> (forall a. Ord a => FaceData h a -> a)
-> (forall a. Ord a => FaceData h a -> a)
-> (forall a. Num a => FaceData h a -> a)
-> (forall a. Num a => FaceData h a -> a)
-> Foldable (FaceData h)
forall a. Eq a => a -> FaceData h a -> Bool
forall a. Num a => FaceData h a -> a
forall a. Ord a => FaceData h a -> a
forall m. Monoid m => FaceData h m -> m
forall a. FaceData h a -> Bool
forall a. FaceData h a -> Int
forall a. FaceData h a -> [a]
forall a. (a -> a -> a) -> FaceData h a -> a
forall h a. Eq a => a -> FaceData h a -> Bool
forall h a. Num a => FaceData h a -> a
forall h a. Ord a => FaceData h a -> a
forall m a. Monoid m => (a -> m) -> FaceData h a -> m
forall h m. Monoid m => FaceData h m -> m
forall h a. FaceData h a -> Bool
forall h a. FaceData h a -> Int
forall h a. FaceData h a -> [a]
forall b a. (b -> a -> b) -> b -> FaceData h a -> b
forall a b. (a -> b -> b) -> b -> FaceData h a -> b
forall h a. (a -> a -> a) -> FaceData h a -> a
forall h m a. Monoid m => (a -> m) -> FaceData h a -> m
forall h b a. (b -> a -> b) -> b -> FaceData h a -> b
forall h a b. (a -> b -> b) -> b -> FaceData h a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: FaceData h a -> a
$cproduct :: forall h a. Num a => FaceData h a -> a
sum :: FaceData h a -> a
$csum :: forall h a. Num a => FaceData h a -> a
minimum :: FaceData h a -> a
$cminimum :: forall h a. Ord a => FaceData h a -> a
maximum :: FaceData h a -> a
$cmaximum :: forall h a. Ord a => FaceData h a -> a
elem :: a -> FaceData h a -> Bool
$celem :: forall h a. Eq a => a -> FaceData h a -> Bool
length :: FaceData h a -> Int
$clength :: forall h a. FaceData h a -> Int
null :: FaceData h a -> Bool
$cnull :: forall h a. FaceData h a -> Bool
toList :: FaceData h a -> [a]
$ctoList :: forall h a. FaceData h a -> [a]
foldl1 :: (a -> a -> a) -> FaceData h a -> a
$cfoldl1 :: forall h a. (a -> a -> a) -> FaceData h a -> a
foldr1 :: (a -> a -> a) -> FaceData h a -> a
$cfoldr1 :: forall h a. (a -> a -> a) -> FaceData h a -> a
foldl' :: (b -> a -> b) -> b -> FaceData h a -> b
$cfoldl' :: forall h b a. (b -> a -> b) -> b -> FaceData h a -> b
foldl :: (b -> a -> b) -> b -> FaceData h a -> b
$cfoldl :: forall h b a. (b -> a -> b) -> b -> FaceData h a -> b
foldr' :: (a -> b -> b) -> b -> FaceData h a -> b
$cfoldr' :: forall h a b. (a -> b -> b) -> b -> FaceData h a -> b
foldr :: (a -> b -> b) -> b -> FaceData h a -> b
$cfoldr :: forall h a b. (a -> b -> b) -> b -> FaceData h a -> b
foldMap' :: (a -> m) -> FaceData h a -> m
$cfoldMap' :: forall h m a. Monoid m => (a -> m) -> FaceData h a -> m
foldMap :: (a -> m) -> FaceData h a -> m
$cfoldMap :: forall h m a. Monoid m => (a -> m) -> FaceData h a -> m
fold :: FaceData h m -> m
$cfold :: forall h m. Monoid m => FaceData h m -> m
Foldable,Functor (FaceData h)
Foldable (FaceData h)
Functor (FaceData h)
-> Foldable (FaceData h)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FaceData h a -> f (FaceData h b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FaceData h (f a) -> f (FaceData h a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FaceData h a -> m (FaceData h b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FaceData h (m a) -> m (FaceData h a))
-> Traversable (FaceData h)
(a -> f b) -> FaceData h a -> f (FaceData h b)
forall h. Functor (FaceData h)
forall h. Foldable (FaceData h)
forall h (m :: * -> *) a.
Monad m =>
FaceData h (m a) -> m (FaceData h a)
forall h (f :: * -> *) a.
Applicative f =>
FaceData h (f a) -> f (FaceData h a)
forall h (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FaceData h a -> m (FaceData h b)
forall h (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FaceData h a -> f (FaceData h b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FaceData h (m a) -> m (FaceData h a)
forall (f :: * -> *) a.
Applicative f =>
FaceData h (f a) -> f (FaceData h a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FaceData h a -> m (FaceData h b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FaceData h a -> f (FaceData h b)
sequence :: FaceData h (m a) -> m (FaceData h a)
$csequence :: forall h (m :: * -> *) a.
Monad m =>
FaceData h (m a) -> m (FaceData h a)
mapM :: (a -> m b) -> FaceData h a -> m (FaceData h b)
$cmapM :: forall h (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FaceData h a -> m (FaceData h b)
sequenceA :: FaceData h (f a) -> f (FaceData h a)
$csequenceA :: forall h (f :: * -> *) a.
Applicative f =>
FaceData h (f a) -> f (FaceData h a)
traverse :: (a -> f b) -> FaceData h a -> f (FaceData h b)
$ctraverse :: forall h (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FaceData h a -> f (FaceData h b)
$cp2Traversable :: forall h. Foldable (FaceData h)
$cp1Traversable :: forall h. Functor (FaceData h)
Traversable,(forall x. FaceData h f -> Rep (FaceData h f) x)
-> (forall x. Rep (FaceData h f) x -> FaceData h f)
-> Generic (FaceData h f)
forall x. Rep (FaceData h f) x -> FaceData h f
forall x. FaceData h f -> Rep (FaceData h f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h f x. Rep (FaceData h f) x -> FaceData h f
forall h f x. FaceData h f -> Rep (FaceData h f) x
$cto :: forall h f x. Rep (FaceData h f) x -> FaceData h f
$cfrom :: forall h f x. FaceData h f -> Rep (FaceData h f) x
Generic)
makeLenses ''FaceData

instance Bifunctor FaceData where
  bimap :: (a -> b) -> (c -> d) -> FaceData a c -> FaceData b d
bimap a -> b
f c -> d
g (FaceData Seq a
hs c
x) = Seq b -> d -> FaceData b d
forall h f. Seq h -> f -> FaceData h f
FaceData ((a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
hs) (c -> d
g c
x)


instance (FromJSON h, FromJSON f) => FromJSON (FaceData h f)
instance (ToJSON h, ToJSON f)     => ToJSON (FaceData h f) where
  toEncoding :: FaceData h f -> Encoding
toEncoding = Options -> FaceData h f -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

--------------------------------------------------------------------------------



-- | Face data, if the face is an inner face, store the component and
-- faceId of it.  If not, this face must be the outer face (and thus
-- we can find all the face id's it correponds to through the
-- FaceData).
data RawFace s f = RawFace { RawFace s f -> Maybe (ComponentId s, FaceId' (Wrap s))
_faceIdx     :: !(Maybe (ComponentId s, FaceId' (Wrap s)))
                           , RawFace s f -> FaceData (Dart s) f
_faceDataVal :: !(FaceData (Dart s) f)
                           } deriving (RawFace s f -> RawFace s f -> Bool
(RawFace s f -> RawFace s f -> Bool)
-> (RawFace s f -> RawFace s f -> Bool) -> Eq (RawFace s f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k) f. Eq f => RawFace s f -> RawFace s f -> Bool
/= :: RawFace s f -> RawFace s f -> Bool
$c/= :: forall k (s :: k) f. Eq f => RawFace s f -> RawFace s f -> Bool
== :: RawFace s f -> RawFace s f -> Bool
$c== :: forall k (s :: k) f. Eq f => RawFace s f -> RawFace s f -> Bool
Eq,Int -> RawFace s f -> ShowS
[RawFace s f] -> ShowS
RawFace s f -> String
(Int -> RawFace s f -> ShowS)
-> (RawFace s f -> String)
-> ([RawFace s f] -> ShowS)
-> Show (RawFace s f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) f. Show f => Int -> RawFace s f -> ShowS
forall k (s :: k) f. Show f => [RawFace s f] -> ShowS
forall k (s :: k) f. Show f => RawFace s f -> String
showList :: [RawFace s f] -> ShowS
$cshowList :: forall k (s :: k) f. Show f => [RawFace s f] -> ShowS
show :: RawFace s f -> String
$cshow :: forall k (s :: k) f. Show f => RawFace s f -> String
showsPrec :: Int -> RawFace s f -> ShowS
$cshowsPrec :: forall k (s :: k) f. Show f => Int -> RawFace s f -> ShowS
Show,a -> RawFace s b -> RawFace s a
(a -> b) -> RawFace s a -> RawFace s b
(forall a b. (a -> b) -> RawFace s a -> RawFace s b)
-> (forall a b. a -> RawFace s b -> RawFace s a)
-> Functor (RawFace s)
forall k (s :: k) a b. a -> RawFace s b -> RawFace s a
forall k (s :: k) a b. (a -> b) -> RawFace s a -> RawFace s b
forall a b. a -> RawFace s b -> RawFace s a
forall a b. (a -> b) -> RawFace s a -> RawFace s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RawFace s b -> RawFace s a
$c<$ :: forall k (s :: k) a b. a -> RawFace s b -> RawFace s a
fmap :: (a -> b) -> RawFace s a -> RawFace s b
$cfmap :: forall k (s :: k) a b. (a -> b) -> RawFace s a -> RawFace s b
Functor,RawFace s a -> Bool
(a -> m) -> RawFace s a -> m
(a -> b -> b) -> b -> RawFace s a -> b
(forall m. Monoid m => RawFace s m -> m)
-> (forall m a. Monoid m => (a -> m) -> RawFace s a -> m)
-> (forall m a. Monoid m => (a -> m) -> RawFace s a -> m)
-> (forall a b. (a -> b -> b) -> b -> RawFace s a -> b)
-> (forall a b. (a -> b -> b) -> b -> RawFace s a -> b)
-> (forall b a. (b -> a -> b) -> b -> RawFace s a -> b)
-> (forall b a. (b -> a -> b) -> b -> RawFace s a -> b)
-> (forall a. (a -> a -> a) -> RawFace s a -> a)
-> (forall a. (a -> a -> a) -> RawFace s a -> a)
-> (forall a. RawFace s a -> [a])
-> (forall a. RawFace s a -> Bool)
-> (forall a. RawFace s a -> Int)
-> (forall a. Eq a => a -> RawFace s a -> Bool)
-> (forall a. Ord a => RawFace s a -> a)
-> (forall a. Ord a => RawFace s a -> a)
-> (forall a. Num a => RawFace s a -> a)
-> (forall a. Num a => RawFace s a -> a)
-> Foldable (RawFace s)
forall a. Eq a => a -> RawFace s a -> Bool
forall a. Num a => RawFace s a -> a
forall a. Ord a => RawFace s a -> a
forall m. Monoid m => RawFace s m -> m
forall a. RawFace s a -> Bool
forall a. RawFace s a -> Int
forall a. RawFace s a -> [a]
forall a. (a -> a -> a) -> RawFace s a -> a
forall k (s :: k) a. Eq a => a -> RawFace s a -> Bool
forall k (s :: k) a. Num a => RawFace s a -> a
forall k (s :: k) a. Ord a => RawFace s a -> a
forall k (s :: k) m. Monoid m => RawFace s m -> m
forall k (s :: k) a. RawFace s a -> Bool
forall k (s :: k) a. RawFace s a -> Int
forall k (s :: k) a. RawFace s a -> [a]
forall k (s :: k) a. (a -> a -> a) -> RawFace s a -> a
forall k (s :: k) m a. Monoid m => (a -> m) -> RawFace s a -> m
forall k (s :: k) b a. (b -> a -> b) -> b -> RawFace s a -> b
forall k (s :: k) a b. (a -> b -> b) -> b -> RawFace s a -> b
forall m a. Monoid m => (a -> m) -> RawFace s a -> m
forall b a. (b -> a -> b) -> b -> RawFace s a -> b
forall a b. (a -> b -> b) -> b -> RawFace s a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: RawFace s a -> a
$cproduct :: forall k (s :: k) a. Num a => RawFace s a -> a
sum :: RawFace s a -> a
$csum :: forall k (s :: k) a. Num a => RawFace s a -> a
minimum :: RawFace s a -> a
$cminimum :: forall k (s :: k) a. Ord a => RawFace s a -> a
maximum :: RawFace s a -> a
$cmaximum :: forall k (s :: k) a. Ord a => RawFace s a -> a
elem :: a -> RawFace s a -> Bool
$celem :: forall k (s :: k) a. Eq a => a -> RawFace s a -> Bool
length :: RawFace s a -> Int
$clength :: forall k (s :: k) a. RawFace s a -> Int
null :: RawFace s a -> Bool
$cnull :: forall k (s :: k) a. RawFace s a -> Bool
toList :: RawFace s a -> [a]
$ctoList :: forall k (s :: k) a. RawFace s a -> [a]
foldl1 :: (a -> a -> a) -> RawFace s a -> a
$cfoldl1 :: forall k (s :: k) a. (a -> a -> a) -> RawFace s a -> a
foldr1 :: (a -> a -> a) -> RawFace s a -> a
$cfoldr1 :: forall k (s :: k) a. (a -> a -> a) -> RawFace s a -> a
foldl' :: (b -> a -> b) -> b -> RawFace s a -> b
$cfoldl' :: forall k (s :: k) b a. (b -> a -> b) -> b -> RawFace s a -> b
foldl :: (b -> a -> b) -> b -> RawFace s a -> b
$cfoldl :: forall k (s :: k) b a. (b -> a -> b) -> b -> RawFace s a -> b
foldr' :: (a -> b -> b) -> b -> RawFace s a -> b
$cfoldr' :: forall k (s :: k) a b. (a -> b -> b) -> b -> RawFace s a -> b
foldr :: (a -> b -> b) -> b -> RawFace s a -> b
$cfoldr :: forall k (s :: k) a b. (a -> b -> b) -> b -> RawFace s a -> b
foldMap' :: (a -> m) -> RawFace s a -> m
$cfoldMap' :: forall k (s :: k) m a. Monoid m => (a -> m) -> RawFace s a -> m
foldMap :: (a -> m) -> RawFace s a -> m
$cfoldMap :: forall k (s :: k) m a. Monoid m => (a -> m) -> RawFace s a -> m
fold :: RawFace s m -> m
$cfold :: forall k (s :: k) m. Monoid m => RawFace s m -> m
Foldable,Functor (RawFace s)
Foldable (RawFace s)
Functor (RawFace s)
-> Foldable (RawFace s)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RawFace s a -> f (RawFace s b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RawFace s (f a) -> f (RawFace s a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RawFace s a -> m (RawFace s b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RawFace s (m a) -> m (RawFace s a))
-> Traversable (RawFace s)
(a -> f b) -> RawFace s a -> f (RawFace s b)
forall k (s :: k). Functor (RawFace s)
forall k (s :: k). Foldable (RawFace s)
forall k (s :: k) (m :: * -> *) a.
Monad m =>
RawFace s (m a) -> m (RawFace s a)
forall k (s :: k) (f :: * -> *) a.
Applicative f =>
RawFace s (f a) -> f (RawFace s a)
forall k (s :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RawFace s a -> m (RawFace s b)
forall k (s :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RawFace s a -> f (RawFace s b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
RawFace s (m a) -> m (RawFace s a)
forall (f :: * -> *) a.
Applicative f =>
RawFace s (f a) -> f (RawFace s a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RawFace s a -> m (RawFace s b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RawFace s a -> f (RawFace s b)
sequence :: RawFace s (m a) -> m (RawFace s a)
$csequence :: forall k (s :: k) (m :: * -> *) a.
Monad m =>
RawFace s (m a) -> m (RawFace s a)
mapM :: (a -> m b) -> RawFace s a -> m (RawFace s b)
$cmapM :: forall k (s :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RawFace s a -> m (RawFace s b)
sequenceA :: RawFace s (f a) -> f (RawFace s a)
$csequenceA :: forall k (s :: k) (f :: * -> *) a.
Applicative f =>
RawFace s (f a) -> f (RawFace s a)
traverse :: (a -> f b) -> RawFace s a -> f (RawFace s b)
$ctraverse :: forall k (s :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RawFace s a -> f (RawFace s b)
$cp2Traversable :: forall k (s :: k). Foldable (RawFace s)
$cp1Traversable :: forall k (s :: k). Functor (RawFace s)
Traversable,(forall x. RawFace s f -> Rep (RawFace s f) x)
-> (forall x. Rep (RawFace s f) x -> RawFace s f)
-> Generic (RawFace s f)
forall x. Rep (RawFace s f) x -> RawFace s f
forall x. RawFace s f -> Rep (RawFace s f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (s :: k) f x. Rep (RawFace s f) x -> RawFace s f
forall k (s :: k) f x. RawFace s f -> Rep (RawFace s f) x
$cto :: forall k (s :: k) f x. Rep (RawFace s f) x -> RawFace s f
$cfrom :: forall k (s :: k) f x. RawFace s f -> Rep (RawFace s f) x
Generic)
makeLenses ''RawFace




-- -- | A FaceIdx is a pair of componentId and FaceId
-- data FaceIdx s = RawIdx !(ComponentId s) -- ^ component Id
--                         !(FaceId' (Wrap s)) -- ^ Face index inside the component
--                deriving (Eq,Show,Generic)

-- instance FromJSON (FaceIdx s)
-- instance ToJSON (FaceIdx s) where
--   toEncoding = genericToEncoding defaultOptions

-- data RawFace s a = RawFace { _internalFaceIn :: !(Maybe (FaceIdx s))
--                            , _externalFaceIn :: ![FaceIdx s]
--                            , _faceDataValue  :: !a
--                            } deriving (Eq,Show,Functor,Foldable,Traversable,Generic)

-- instance FromJSON f => FromJSON (RawFace s f)
-- instance ToJSON f => ToJSON (RawFace s f) where
--   toEncoding = genericToEncoding defaultOptions

-- -- | get the data value of a raw face.
-- faceDataVal :: Lens (RawFace s a) (RawFace s b) a b
-- faceDataVal = lens _faceDataValue (\(RawFace i es _) x -> RawFace i es x)