{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Ipe.FromIpe
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Functions that help reading geometric values from ipe images.
--
--------------------------------------------------------------------------------
module Data.Geometry.Ipe.FromIpe(
  -- * Individual readers
    _asPoint
  , _asLineSegment
  , _asRectangle
  , _asTriangle

  , _asPolyLine
  , _asSomePolygon, _asSimplePolygon, _asMultiPolygon

  -- * Dealing with Attributes
  , _withAttrs

  -- * Default readers
  , HasDefaultFromIpe(..)

  -- * Reading all elements of a particular type
  , readAll, readAllFrom
  ) where

import           Control.Lens hiding (Simple)
import           Data.Ext
import           Data.Geometry.Ball
import           Data.Geometry.Box
import           Data.Geometry.Ellipse (Ellipse, _EllipseCircle)
import           Data.Geometry.Ipe.Path
import           Data.Geometry.Ipe.Reader
import           Data.Geometry.Ipe.Types
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import qualified Data.Geometry.PolyLine as PolyLine
import           Data.Geometry.Polygon
import           Data.Geometry.Properties
import           Data.Geometry.Triangle
import qualified Data.LSeq as LSeq
import           Data.List.NonEmpty (NonEmpty(..))

--------------------------------------------------------------------------------
-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Geometry.Ipe.Attributes
-- >>> import Data.Geometry.Ipe.Color(IpeColor(..))
-- >>> import Data.Geometry.Point
-- >>> :{
-- let testPath :: Path Int
--     testPath = Path . fromSingleton  . PolyLineSegment
--              . PolyLine.fromPoints . map ext
--              $ [ origin, Point2 10 10, Point2 200 100 ]
--     testPathAttrs :: IpeAttributes Path Int
--     testPathAttrs = attr SStroke (IpeColor "red")
--     testObject :: IpeObject Int
--     testObject = IpePath (testPath :+ testPathAttrs)
-- :}



-- | Extracts the point from a Symbol. When creating a symbol this
-- creates a disk that supports a stroke color.
_asPoint :: Prism' (IpeSymbol r) (Point 2 r)
_asPoint = prism' (flip Symbol "mark/disk(sx)") (Just . view symbolPoint)

-- | Try to convert a path into a line segment, fails if the path is not a line
-- segment or a polyline with more than two points.
--
--
_asLineSegment :: Prism' (Path r) (LineSegment 2 () r)
_asLineSegment = prism' seg2path path2seg
  where
    seg2path   = review _asPolyLine . PolyLine.fromLineSegment
    path2seg p = PolyLine.asLineSegment' =<< preview _asPolyLine p

-- | Convert to a polyline. Ignores all non-polyline parts
--
-- >>> testPath ^? _asPolyLine
-- Just (PolyLine {_points = LSeq (fromList [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [200,100] :+ ()])})
_asPolyLine :: Prism' (Path r) (PolyLine.PolyLine 2 () r)
_asPolyLine = prism' poly2path path2poly
  where
    poly2path = Path . fromSingleton  . PolyLineSegment
    path2poly = preview (pathSegments.traverse._PolyLineSegment)
    -- TODO: Check that the path actually is a polyline, rather
    -- than ignoring everything that does not fit

-- | Convert to a simple polygon
_asSimplePolygon :: Prism' (Path r) (Polygon Simple () r)
_asSimplePolygon = _asSomePolygon._Left


-- | Tries to convert a path into a rectangle.
_asRectangle :: forall r. (Num r, Ord r) => Prism' (Path r) (Rectangle () r)
_asRectangle = prism' rectToPath pathToRect
  where
    rectToPath (corners -> Corners a b c d) = review _asSimplePolygon . fromPoints $ [a,b,c,d]
    pathToRect p = p^?_asSimplePolygon >>= asRect

    asRect    :: SimplePolygon () r -> Maybe (Rectangle () r)
    asRect pg = case pg^..outerBoundary.traverse of
        [a,b,c,d] | isH a b && isV b c && isH c d && isV d a -> Just (boundingBoxList' [a,c])
        [a,b,c,d] | isV a b && isH b c && isV c d && isH d a -> Just (boundingBoxList' [a,c])
        _                                                    -> Nothing

    isH (p :+ _) (q :+ _) = p^.xCoord == q^.xCoord
    isV (p :+ _) (q :+ _) = p^.yCoord == q^.yCoord


-- | Convert to a triangle
_asTriangle :: Prism' (Path r) (Triangle 2 () r)
_asTriangle = prism' triToPath path2tri
  where
    triToPath (Triangle p q r) = polygonToPath . fromPoints . map (&extra .~ ()) $ [p,q,r]
    path2tri p = case p^..pathSegments.traverse._PolygonPath of
                    []   -> Nothing
                    [pg] -> case polygonVertices pg of
                              (a :| [b,c]) -> Just $ Triangle a b c
                              _            -> Nothing
                    _    -> Nothing


  -- an ellipse is an affine transformation of the unit disk


-- (Disk origin 1) (Vector2 1 1)

_asEllipse :: Prism' (Path r) (Ellipse r)
_asEllipse = prism' toPath toEllipse
  where
    toPath      = Path . fromSingleton  . EllipseSegment
    toEllipse p = case p^..pathSegments.traverse._EllipseSegment of
                    [e] -> Just e
                    _   -> Nothing

_asCircle :: (Floating r, Eq r) => Prism' (Path r) (Circle () r)
_asCircle = _asEllipse._EllipseCircle
-- FIXME: For reading we should not need the floating constraint!

_asDisk :: (Floating r, Eq r) => Prism' (Path r) (Disk () r)
_asDisk = _asCircle.from _DiskCircle


-- | Convert to a multipolygon
_asMultiPolygon :: Prism' (Path r) (MultiPolygon () r)
_asMultiPolygon = _asSomePolygon._Right

-- _asPolygon :: Prism' (Path r) (forall t. Polygon t () r)
-- _asPolygon = prism' polygonToPath (fmap (either id id) . pathToPolygon)

_asSomePolygon :: Prism' (Path r) (SomePolygon () r)
_asSomePolygon = prism' embed pathToPolygon
  where
    embed     = either polygonToPath polygonToPath


polygonToPath                      :: Polygon t () r -> Path r
polygonToPath pg@(SimplePolygon _) = Path . fromSingleton . PolygonPath $ pg
polygonToPath (MultiPolygon vs hs) = Path . LSeq.fromNonEmpty . fmap PolygonPath
                                   $ (SimplePolygon vs) :| hs


pathToPolygon   :: Path r -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
pathToPolygon p = case p^..pathSegments.traverse._PolygonPath of
                    []                   -> Nothing
                    [pg]                 -> Just . Left  $ pg
                    SimplePolygon vs: hs -> Just . Right $ MultiPolygon vs hs





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


-- | Use the first prism to select the ipe object to depicle with, and the second
-- how to select the geometry object from there on. Then we can select the geometry
-- object, directly with its attributes here.
--
-- >>> testObject ^? _withAttrs _IpePath _asPolyLine
-- Just (PolyLine {_points = LSeq (fromList [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [200,100] :+ ()])} :+ Attrs {NoAttr, NoAttr, NoAttr, NoAttr, Attr IpeColor (Named "red"), NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})
_withAttrs       :: Prism' (IpeObject r) (i r :+ IpeAttributes i r) -> Prism' (i r) g
                 -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs po pg = prism' g2o o2g
  where
    g2o    = review po . over core (review pg)
    o2g o  = preview po o >>= \(i :+ ats) -> (:+ ats) <$> preview pg i





-- instance HasDefaultIpeObject Path where
--   defaultIpeObject' = _IpePath


-- class HasDefaultFromIpe g where
--   type DefaultFromIpe g :: * -> *
--   defaultIpeObject :: proxy g -> Prism' (IpeObject r) (DefaultFromIpe g r :+ IpeAttributes (DefaultFromIpe g) r)
--   defaultFromIpe   :: proxy g -> Prism' (DefaultFromIpe g (NumType g)) g


class HasDefaultFromIpe g where
  type DefaultFromIpe g :: * -> *
  defaultFromIpe :: (r ~ NumType g)
                 => Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r)

instance HasDefaultFromIpe (Point 2 r) where
  type DefaultFromIpe (Point 2 r) = IpeSymbol
  defaultFromIpe = _withAttrs _IpeUse _asPoint
    where


instance HasDefaultFromIpe (LineSegment 2 () r) where
  type DefaultFromIpe (LineSegment 2 () r) = Path
  defaultFromIpe = _withAttrs _IpePath _asLineSegment

instance HasDefaultFromIpe (Ellipse r) where
  type DefaultFromIpe (Ellipse r) = Path
  defaultFromIpe = _withAttrs _IpePath _asEllipse

instance (Floating r, Eq r) => HasDefaultFromIpe (Circle () r) where
  type DefaultFromIpe (Circle () r) = Path
  defaultFromIpe = _withAttrs _IpePath _asCircle

instance (Floating r, Eq r) => HasDefaultFromIpe (Disk () r) where
  type DefaultFromIpe (Disk () r) = Path
  defaultFromIpe = _withAttrs _IpePath _asDisk

instance HasDefaultFromIpe (PolyLine.PolyLine 2 () r) where
  type DefaultFromIpe (PolyLine.PolyLine 2 () r) = Path
  defaultFromIpe = _withAttrs _IpePath _asPolyLine


instance HasDefaultFromIpe (SimplePolygon () r) where
  type DefaultFromIpe (SimplePolygon () r) = Path
  defaultFromIpe = _withAttrs _IpePath _asSimplePolygon

instance HasDefaultFromIpe (MultiPolygon () r) where
  type DefaultFromIpe (MultiPolygon () r) = Path
  defaultFromIpe = _withAttrs _IpePath _asMultiPolygon


-- | Read all g's from some ipe page(s).
readAll   :: (HasDefaultFromIpe g, r ~ NumType g)
          => IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAll p = p^..content.traverse.defaultFromIpe

-- | Convenience function from reading all g's from an ipe file. If there
-- is an error reading or parsing the file the error is "thrown away".
readAllFrom    :: (HasDefaultFromIpe g, r ~ NumType g, Coordinate r, Eq r)
               => FilePath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllFrom fp = foldMap readAll <$> readSinglePageFile fp

fromSingleton :: a -> LSeq.LSeq 1 a
fromSingleton = LSeq.fromNonEmpty . (:| [])