{-# Language TypeFamilies
  #-}
module Data.Geometry.Ipe.IpeTypes( IpeDrawing(..)
                                 , Page(..)
                                 , Layer(..)
                                 , emptyDrawing
                                 , emptyPage
                                 , emptyLayer
                                 , HasContent(..)
                                 , extend
                                 -- * Working with views
                                 , view
                                 -- * Running computations on ipe files
                                 , runOnFile
                                 , runOnPath
                                 -- * Querying
                                 , findLayer
                                 , findLayer'
                                 -- * Other types
                                 , IpeFile
                                 , LayerDefinition
                                 , ViewDefinition(..)
                                 , AMap
                                 , HasAttributes(..)
                                 ) where

import Control.Arrow

import Data.Monoid
import Data.Function(on)

import Data.Maybe
import Data.List

import Data.Geometry.Point
import Data.Geometry.Geometry

import Data.Geometry.Ipe.IGC(IGC,empty,mergeAll,updateAll)

import Data.Geometry.Ipe.ReadIpeGeometry hiding (PM)
import Data.Geometry.Ipe.WriteIpeGeometry hiding (PM)

import Data.Geometry.Ipe.InternalTypes

import Data.Geometry.Ipe.Pickle


--------------------------------------------------------------------------------------
-- | Representing ipe drawings


data IpeDrawing a = IpeDrawing { pages :: [Page a] }
                  deriving (Show,Eq)


data Page a = Page { layers :: [Layer a]
                   , views  :: [ViewDefinition]
                   }
              deriving (Show,Eq)

data Layer a = Layer { layerDef     :: LayerDefinition
                     , layerContent :: IGC a
                     }
               deriving (Show,Eq)

-- | A new blank ipe drawing
emptyDrawing :: IpeDrawing a
emptyDrawing = IpeDrawing [emptyPage]

-- | A new empty page
emptyPage :: Page a
emptyPage = Page [emptyLayer] []

emptyLayer :: Layer a
emptyLayer = Layer "alpha" empty


instance Monoid (IpeDrawing a) where
    mempty = emptyDrawing
    (IpeDrawing pgs) `mappend` (IpeDrawing pgs') = IpeDrawing $ pgs++pgs'

-- | Merges the two drawings. i.e. page by page we merge the pages in the sense
-- that objects on layers with the same names are *BOTH* included
extend :: IpeDrawing a -> IpeDrawing a -> IpeDrawing a
extend (IpeDrawing pgs) (IpeDrawing pgs') = IpeDrawing $ zipWith mappend pgs pgs'

-- | When mappending two pages, they are are merged, i.e. if both contain a
-- layer named A, say layers l and r, then the output page contains only one
-- layer named A, containing all items from both l and r
instance Monoid (Page a) where
    mempty = emptyPage
    p@(Page lrs vds) `mappend` q@(Page lrs' vds') =
        Page (combineLayers lrs lrs') (vds ++ vds')

-- | Combines a set of layers by merging layers with a common name
combineLayers :: [Layer a] -> [Layer a] -> [Layer a]
combineLayers lrs lrs' = map mergeCommon commonNames ++
                         filter (not . inSet commonNames) (lrs++lrs')
    where
      names         = map layerDef
      commonNames   = names lrs `intersect` names lrs'
      inSet ns lr   = let n = layerDef lr in n `elem` ns
      mergeCommon n = findL n lrs `mergeLayers` findL n lrs'

mergeLayers                      :: Maybe (Layer a) -> Maybe (Layer a) -> Layer a
mergeLayers (Just lr) (Just lr') = lr `mappend` lr'
mergeLayers mlr       mlr'       = fromMaybe mempty (mlr `mappend` mlr')


instance Monoid (Layer a) where
    mempty = emptyLayer
    (Layer n xs) `mappend` (Layer _ ys) = Layer n (xs `mappend` ys)


--------------------------------------------------------------------------------------
-- | Working with views

-- data View a = View [Layer a]
--                  deriving (Show,Eq)

view      :: [LayerDefinition] -> ViewDefinition
view lrns = ViewDefinition lrns (head lrns)









--------------------------------------------------------------------------------------
-- | Getting the content of pages/layers etc

class HasContent t where
    type PM t
    content :: t -> IGC (PM t)

instance HasContent (IpeDrawing a) where
    type PM (IpeDrawing a) = a
    content = mergeAll . map content . pages


instance HasContent (Page a) where
    type PM (Page a) = a
    content = mergeAll . map content . layers

instance HasContent (Layer a) where
    type PM (Layer a) = a
    content = layerContent


-----------------------------------------------------------------------------------
-- | Converting between IpeFile and IpeDrawings, and IpePages and Pages

fromIpeFile :: IpeFile a -> IpeDrawing a
fromIpeFile (IpeFile _ _ pgs) = IpeDrawing $ map gatherPage pgs

gatherPage                   :: IpePage a -> Page a
gatherPage (IpePage _ vds obs) = Page lrs vds
    where
      lrs        = map mkLayer .  groupBy' layerName $ obs
      groupBy' f = groupBy ((==) `on` f) . sortBy (compare `on` f)

      mkLayer           :: [IpeObject a] -> Layer a
      mkLayer []        = emptyLayer -- This should not really occur
      mkLayer obs@(o:_) = Layer (layerName o) (listToIGC obs)

      layerName :: IpeObject a -> String
      layerName = fromMaybe "alpha" . getAttr "layer"

updateIpeFile                          :: IpeFile t -> IpeDrawing a -> IpeFile a
updateIpeFile ipeFile (IpeDrawing pgs) =
    ipeFile { ipePages = map constructIpePage pgs}

constructIpePage                :: Page a -> IpePage a
constructIpePage (Page lrs vds) = IpePage lds vds obs
    where
      lds             = map layerDef lrs
      obs             = toIpeObjects' . mergeAll . map f $ lrs
      f (Layer n col) = updateAll (setAttr "layer" n) col

--------------------------------------------------------------------------------------
-- | Manipulating Ipe documents




runOnPath f = loadFileA >>> runOnFile f


runOnFile   :: Arrow arr => arr (IpeDrawing a) (IpeDrawing b) -> arr (IpeFile a) (IpeFile b)
runOnFile f = arr id &&& (fromIpeFile ^>> f)
              >>>
              arr (uncurry updateIpeFile)


-----------------------------------------------------------------------------------
-- | Querying a drawing for layers/views/pages etc

findLayer                       :: Int -> LayerDefinition -> IpeDrawing a -> Maybe (Layer a)
findLayer i lr (IpeDrawing pgs) = let mpg = listToMaybe . drop i $ pgs in
                                  mpg >>= findLayer' lr

findLayer'      :: LayerDefinition -> Page a -> Maybe (Layer a)
findLayer' name = findL name . layers

findL name = listToMaybe . filter ((== name) . layerDef)