{-# Language RankNTypes
  #-}
module Data.Geometry.Ipe.IGC( IGC(..)
                            , IsIpeGeometry(..)
                            , empty
                            , singleton
                            , fromList
                            , mergeAll
                            , updateAll
                            ) where

import Data.Monoid
import Data.Geometry.Ipe.InternalTypes(HasAttributes(..))
import Data.Geometry.Ipe.IpeGeometryTypes

-- | an ipe geometry collection
data IGC a = IGC { name           :: String
                 , points         :: [IpePoint' a]
                 , polyLines      :: [IpePolyline' a]
                 , simplePolygons :: [IpeSimplePolygon' a]
                 , multiPolygons  :: [IpeMultiPolygon' a]
                 }
             deriving (Show,Eq)


instance Monoid (IGC a) where
    mempty = empty
    mappend = merge


empty :: IGC a
empty = IGC "" [] [] [] []

-- merge/concatenate the two collections. Take the name of the first one
merge                                                     :: IGC a -> IGC a -> IGC a
merge (IGC n pts pll sps mps) (IGC _ pts' pll' sps' mps') =
    IGC n (pts ++ pts') (pll ++ pll') (sps ++ sps') (mps ++ mps')

mergeAll :: [IGC a] -> IGC a
mergeAll = foldr merge empty


updateAll  :: (forall t. HasAttributes t => t -> t) -> IGC a -> IGC a
updateAll f (IGC n pts pll spsm mps) = IGC n (map f pts)
                                             (map f pll)
                                             (map f spsm)
                                             (map f mps)


-- | Stuff that we can store in a IpGeometryCollection
class  IsIpeGeometry g where
    insert :: g a -> IGC a -> IGC a
    -- | shorhand for insert
    (<|)   :: g a -> IGC a -> IGC a
    g <| c = insert g c

    insertAll :: [g a] -> IGC a -> IGC a
    insertAll gs col = foldr insert col gs

instance IsIpeGeometry IpePoint' where
    insert p (IGC n pts pll sps mps) =
        IGC n (p:pts) pll sps mps

instance IsIpeGeometry IpePolyline' where
    insert p (IGC n pts pll sps mps) =
        IGC n pts (p:pll) sps mps


instance IsIpeGeometry IpeSimplePolygon' where
    insert p (IGC n pts pll sps mps) =
        IGC n pts pll (p:sps) mps

instance IsIpeGeometry IpeMultiPolygon' where
    insert p (IGC n pts pll sps mps) =
        IGC n pts pll sps (p:mps)

singleton :: IsIpeGeometry g => g a -> IGC a
singleton g = g <| empty

fromList :: IsIpeGeometry g => [g a] -> IGC a
fromList = flip insertAll empty