{-# 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 { unCI :: Int } deriving (Show,Eq,Ord,Generic,Bounded,Enum,ToJSON,FromJSON) -------------------------------------------------------------------------------- -- | Helper type for the data that we store in a planar subdivision data Raw s ia a = Raw { _compId :: !(ComponentId s) , _idxVal :: !ia , _dataVal :: !a } deriving (Eq,Show,Functor,Foldable,Traversable,Generic) instance (FromJSON ia, FromJSON a) => FromJSON (Raw s ia a) instance (ToJSON ia, ToJSON a) => ToJSON (Raw s ia a) where toEncoding = genericToEncoding defaultOptions -- | get the dataVal of a Raw dataVal :: Lens (Raw s ia a) (Raw s ia b) a b dataVal = lens (\(Raw _ _ x) -> x) (\(Raw c i _) y -> Raw c i y) -------------------------------------------------------------------------------- -- | The Face data consists of the data itself and a list of holes data FaceData h f = FaceData { _holes :: (Seq.Seq h) , _fData :: !f } deriving (Show,Eq,Ord,Functor,Foldable,Traversable,Generic) makeLenses ''FaceData instance Bifunctor FaceData where bimap f g (FaceData hs x) = FaceData (fmap f hs) (g x) instance (FromJSON h, FromJSON f) => FromJSON (FaceData h f) instance (ToJSON h, ToJSON f) => ToJSON (FaceData h f) where toEncoding = genericToEncoding 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 { _faceIdx :: !(Maybe (ComponentId s, FaceId' (Wrap s))) , _faceDataVal :: !(FaceData (Dart s) f) } deriving (Eq,Show,Functor,Foldable,Traversable,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)