hgeometry-ipe 0.11.0.0 → 0.12.0.0

raw patch · 8 files changed

+126/−69 lines, 8 filesdep +singletons-thdep ~hgeometrydep ~hgeometry-combinatorialdep ~singletonsPVP ok

version bump matches the API change (PVP)

Dependencies added: singletons-th

Dependency ranges changed: hgeometry, hgeometry-combinatorial, singletons

API changes (from Hackage documentation)

Files

• hgeometry-ipe.cabal +17/−7
• src/Data/Geometry/Ipe/Content.hs +1/−1
• src/Data/Geometry/Ipe/FromIpe.hs +9/−8
• src/Data/Geometry/Ipe/IpeOut.hs +52/−13
• src/Data/Geometry/Ipe/Reader.hs +22/−13
• src/Data/Geometry/Ipe/Writer.hs +24/−23
• src/Data/Geometry/QuadTree/Draw.hs +0/−3
• src/Data/Geometry/Triangulation/Draw.hs +1/−1

@@ -1,5 +1,5 @@ name:                hgeometry-ipe-version:             0.11.0.0+version:             0.12.0.0 synopsis:            Reading and Writing ipe7 files. description:    Reading and Writing ipe7 files and converting them to and from HGeometry types.@@ -83,7 +83,6 @@               , linear           >= 1.10               , semigroupoids    >= 5               , semigroups       >= 0.18-              , singletons       >= 2.0               , text             >= 1.1.1.0               , vinyl            >= 0.10               , deepseq          >= 1.1@@ -94,8 +93,8 @@               , QuickCheck              >= 2.5               , quickcheck-instances    >= 0.3 -              , hgeometry-combinatorial >= 0.11.0.0-              , hgeometry               >= 0.11.0.0+              , hgeometry-combinatorial >= 0.12.0.0+              , hgeometry               >= 0.12.0.0                -- , validation       >= 0.4 @@ -117,12 +116,20 @@                -- , hslua +  if impl(ghc == 9.*)+    build-depends:      singletons              == 3.*+                      , singletons-th           == 3.*+  else+    build-depends:      singletons              == 2.*    hs-source-dirs: src                   -- examples/demo    default-language:    Haskell2010 +  if impl(ghc >= 8.10)+    default-extensions: StandaloneKindSignatures+   default-extensions: TypeFamilies                     , GADTs                     , KindSignatures@@ -181,13 +188,18 @@                       , vector                       , containers                       , random-                      , singletons                       , colour                       , filepath                       , directory                       , yaml                       , MonadRandom +  if impl(ghc == 9.*)+    build-depends:      singletons              == 3.*+                      , singletons-th           == 3.*+  else+    build-depends:      singletons              == 2.*+   default-extensions: TypeFamilies                     , GADTs                     , KindSignatures@@ -211,8 +223,6 @@                     , DeriveFunctor                     , DeriveFoldable                     , DeriveTraversable--                    , AutoDeriveTypeable                      , FlexibleInstances                     , FlexibleContexts

@@ -211,7 +211,7 @@   transformBy t (Group s) = Group $ fmap (transformBy t) s  -type family AttributesOf (t :: * -> *) :: [u] where+type family AttributesOf (t :: * -> *) :: [AttributeUniverse] where   AttributesOf Group     = GroupAttributes   AttributesOf Image     = CommonAttributes   AttributesOf TextLabel = CommonAttributes

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Ipe.FromIpe@@ -105,7 +106,7 @@     pathToRect p = p^?_asSimplePolygon >>= asRect      asRect    :: SimplePolygon () r -> Maybe (Rectangle () r)-    asRect pg = case pg^..outerBoundary.traverse of+    asRect pg = case pg^..outerBoundaryVector.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@@ -118,7 +119,7 @@ _asTriangle :: Prism' (Path r) (Triangle 2 () r) _asTriangle = prism' triToPath path2tri   where-    triToPath (Triangle p q r) = polygonToPath . fromPoints . map (&extra .~ ()) $ [p,q,r]+    triToPath (Triangle p q r) = polygonToPath . unsafeFromPoints . map (&extra .~ ()) $ [p,q,r]     path2tri p = case p^..pathSegments.traverse._PolygonPath of                     []   -> Nothing                     [pg] -> case polygonVertices pg of@@ -162,16 +163,16 @@   polygonToPath                      :: Polygon t () r -> Path r-polygonToPath pg@(SimplePolygon _) = Path . fromSingleton . PolygonPath $ pg+polygonToPath pg@SimplePolygon{}   = Path . fromSingleton . PolygonPath $ pg polygonToPath (MultiPolygon vs hs) = Path . LSeq.fromNonEmpty . fmap PolygonPath-                                   $ (SimplePolygon vs) :| hs+                                   $ 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+                    []    -> Nothing+                    [pg]  -> Just . Left  $ pg+                    vs:hs -> Just . Right $ MultiPolygon vs hs   @@ -249,7 +250,7 @@   -- | Read all g's from some ipe page(s).-readAll   :: (HasDefaultFromIpe g, r ~ NumType g)+readAll   :: forall g r. (HasDefaultFromIpe g, r ~ NumType g)           => IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r] readAll p = p^..content.traverse.defaultFromIpe 

@@ -22,10 +22,10 @@ import           Data.Ext import           Data.Foldable (toList) import           Data.Geometry.Ball-import           Data.Geometry.Ellipse(Ellipse, circleToEllipse)-import           Data.Geometry.BezierSpline import           Data.Geometry.Boundary import           Data.Geometry.Box+import           Data.Geometry.Ellipse (Ellipse, circleToEllipse)+import           Data.Geometry.HalfLine import           Data.Geometry.Ipe.Attributes import           Data.Geometry.Ipe.Color (IpeColor(..)) import           Data.Geometry.Ipe.FromIpe@@ -42,6 +42,7 @@ import           Data.Maybe (fromMaybe) import           Data.Text (Text) import qualified Data.Text as Text+import           Data.Vinyl (Rec(..)) import           Data.Vinyl.CoRec import           Linear.Affine ((.+^)) @@ -137,14 +138,12 @@  instance (Fractional r, Ord r) => HasDefaultIpeOut (Line 2 r) where   type DefaultIpeOut (Line 2 r) = Path-  defIO = ipeLineSegment . toSeg-    where-      b :: Rectangle () r-      b = box (ext $ Point2 (-200) (-200)) (ext $ Point2 1200 1200)-      naive (Line p v) = ClosedLineSegment (ext p) (ext $ p .+^ v)-      toSeg l = fromMaybe (naive l) . asA @(LineSegment 2 () r)-              $ l `intersect` b+  defIO = ipeLine +instance (Fractional r, Ord r) => HasDefaultIpeOut (HalfLine 2 r) where+  type DefaultIpeOut (HalfLine 2 r) = Path+  defIO = ipeHalfLine+ instance HasDefaultIpeOut (Polygon t p r) where   type DefaultIpeOut (Polygon t p r) = Path   defIO = ipePolygon@@ -185,6 +184,46 @@ -------------------------------------------------------------------------------- -- * Path Converters +-- | Size of the default bounding box used to clip lines and+-- half-lines in the default IpeOuts.+defaultBox :: Num r => Rectangle () r+defaultBox = let z  = 1000+                 z' = negate z+             in box (ext $ Point2 z' z') (ext $ Point2 z z)++-- | Renders a line as a Path. The line is clipped to the 'defaultBox'+ipeLine :: (Ord r, Fractional r) => IpeOut (Line 2 r) Path r+ipeLine = ipeLineIn defaultBox++-- | Renders the line in the given box.+--+-- pre: the intersection of the box with the line is non-empty+ipeLineIn        :: forall p r. (Ord r, Fractional r)+                 => Rectangle p r -> IpeOut (Line 2 r) Path r+ipeLineIn bBox l = match (l `intersect` bBox) $+     H (\NoIntersection    -> error "ipeLineIn: precondition failed, no intersection")+  :& H (\(_p :: Point 2 r) -> error "ipeLineIn: precondition failed, single point")+  :& H ipeLineSegment+  :& RNil++-- | Renders an Halfine.+--+--+-- pre: the intersection of the box with the line is non-empty+ipeHalfLine :: (Ord r, Fractional r) => IpeOut (HalfLine 2 r) Path r+ipeHalfLine = ipeHalfLineIn defaultBox++-- | Renders the HalfLine in the given box.+--+-- pre: the intersection of the box with the line is non-empty+ipeHalfLineIn        :: forall p r. (Ord r, Fractional r)+                     => Rectangle p r -> IpeOut (HalfLine 2 r) Path r+ipeHalfLineIn bBox l = match (l `intersect` bBox) $+     H (\NoIntersection    -> error "ipeHalfLineIn: precondition failed, no intersection")+  :& H (\(_p :: Point 2 r) -> error "ipeHalfLineIn: precondition failed, single point")+  :& H ipeLineSegment+  :& RNil+ ipeLineSegment   :: IpeOut (LineSegment 2 p r) Path r ipeLineSegment s = (path . pathSegment $ s) :+ mempty @@ -192,7 +231,7 @@ ipePolyLine p = (path . PolyLineSegment . first (const ()) $ p) :+ mempty  ipeEllipse :: IpeOut (Ellipse r) Path r-ipeEllipse = \e -> (path $ EllipseSegment e) :+ mempty+ipeEllipse = \e -> path (EllipseSegment e) :+ mempty  ipeCircle :: Floating r => IpeOut (Circle p r) Path r ipeCircle = ipeEllipse . circleToEllipse@@ -210,13 +249,13 @@ -- | Draw a polygon ipePolygon                          :: IpeOut (Polygon t p r) Path r ipePolygon (first (const ()) -> pg) = case pg of-               (SimplePolygon _)  -> pg^.re _asSimplePolygon :+ mempty-               (MultiPolygon _ _) -> pg^.re _asMultiPolygon  :+ mempty+               SimplePolygon{} -> pg^.re _asSimplePolygon :+ mempty+               MultiPolygon{}  -> pg^.re _asMultiPolygon  :+ mempty   -- | Draw a Rectangle ipeRectangle   :: Num r => IpeOut (Rectangle p r) Path r-ipeRectangle r = ipePolygon $ fromPoints [tl,tr,br,bl]+ipeRectangle r = ipePolygon $ unsafeFromPoints [tl,tr,br,bl]   where     Corners tl tr br bl = corners r 

@@ -5,6 +5,7 @@                                  readRawIpeFile                                , readIpeFile                                , readSinglePageFile+                               , readSinglePageFileThrow                                , ConversionError                                 -- * Reading XML directly@@ -26,32 +27,33 @@                                , Coordinate(..)                                ) where -import           Control.Applicative((<|>))+import           Control.Applicative ((<|>)) import           Control.Lens hiding (Const, rmap)+import           Data.Bifunctor import qualified Data.ByteString as B import           Data.Colour.SRGB (RGB(..)) import           Data.Either (rights) import           Data.Ext-import           Data.Geometry.Box import           Data.Geometry.BezierSpline-import           Data.Geometry.Ellipse(ellipseMatrix)+import           Data.Geometry.Box+import           Data.Geometry.Ellipse (ellipseMatrix) import           Data.Geometry.Ipe.Attributes+import           Data.Geometry.Ipe.Color (IpeColor(..))+import           Data.Geometry.Ipe.Matrix import           Data.Geometry.Ipe.ParserPrimitives (pInteger, pWhiteSpace)-import           Data.Geometry.Ipe.PathParser import           Data.Geometry.Ipe.Path-import           Data.Geometry.Ipe.Matrix+import           Data.Geometry.Ipe.PathParser import           Data.Geometry.Ipe.Types import           Data.Geometry.Ipe.Value-import           Data.Geometry.Ipe.Color(IpeColor(..))+import qualified Data.Geometry.Matrix as Matrix import           Data.Geometry.Point import           Data.Geometry.PolyLine import qualified Data.Geometry.Polygon as Polygon-import qualified Data.Geometry.Matrix as Matrix+import qualified Data.LSeq as LSeq import qualified Data.List as L import qualified Data.List.NonEmpty as NonEmpty import           Data.Maybe (fromMaybe, mapMaybe) import           Data.Proxy-import qualified Data.LSeq as LSeq import           Data.Singletons import           Data.Text (Text) import qualified Data.Text as T@@ -78,7 +80,7 @@ -- This function applies all matrices to objects. readIpeFile :: (Coordinate r, Eq r)             => FilePath -> IO (Either ConversionError (IpeFile r))-readIpeFile = fmap (bimap id applyMatrices) . readRawIpeFile+readIpeFile = fmap (second applyMatrices) . readRawIpeFile   -- | Since most Ipe file contain only one page, we provide a shortcut for that@@ -94,6 +96,13 @@     f   :: IpeFile r -> IpePage r     f i = withDefaults . NonEmpty.head $ i^.pages +-- | Tries to read a single page file, throws an error when this+-- fails. See 'readSinglePageFile' for further details.+readSinglePageFileThrow    :: (Coordinate r, Eq r) => FilePath -> IO (IpePage r)+readSinglePageFileThrow fp = readSinglePageFile fp >>= \case+  Left err -> fail (show err)+  Right p  -> pure p+ -- | Given a Bytestring, try to parse the bytestring into anything that is -- IpeReadable, i.e. any of the Ipe elements. fromIpeXML   :: IpeRead (t r) => B.ByteString -> Either ConversionError (t r)@@ -101,7 +110,7 @@  -- | Reads the data from a Bytestring into a proper Node readXML :: B.ByteString -> Either ConversionError (Node Text Text)-readXML = bimap (T.pack . show) id . parse' defaultParseOptions+readXML = first (T.pack . show) . parse' defaultParseOptions  -------------------------------------------------------------------------------- @@ -205,7 +214,7 @@       fromOps' _ []             = Left "Found only a MoveTo operation"       fromOps' s (LineTo q:ops) = let (ls,xs) = span' _LineTo ops                                       pts  = map ext $ s:q:mapMaybe (^?_LineTo) ls-                                      poly = Polygon.fromPoints . dropRepeats $ pts+                                      poly = Polygon.unsafeFromPoints . dropRepeats $ pts                                       pl   = fromPointsUnsafe pts                                   in case xs of                                        (ClosePath : xs') -> PolygonPath poly   <<| xs'@@ -242,8 +251,8 @@   ipeReadAttr _ _                 = Left "IpeReadAttr: Element expected, Text found"  -- | Combination of zipRecWith and traverse-zipTraverseWith                       :: forall f g h i (rs :: [u]). Applicative h-                                      => (forall (x :: u). f x -> g x -> h (i x))+zipTraverseWith                       :: forall f g h i (rs :: [AttributeUniverse]). Applicative h+                                      => (forall (x :: AttributeUniverse). f x -> g x -> h (i x))                                       -> Rec f rs -> Rec g rs -> h (Rec i rs) zipTraverseWith _ RNil      RNil      = pure RNil zipTraverseWith f (x :& xs) (y :& ys) = (:&) <$> f x y <*> zipTraverseWith f xs ys

@@ -1,5 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------------------- -- |@@ -22,41 +22,42 @@                                , ipeWriteAttrs, writeAttrValues                                ) where -import           Control.Lens (view, (^.), (^..), (.~), (&))-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as C-import           Data.Colour.SRGB (RGB(..))+import           Control.Lens                 (view, (&), (.~), (^.), (^..))+import qualified Data.ByteString              as B+import qualified Data.ByteString.Char8        as C+import           Data.Colour.SRGB             (RGB (..)) import           Data.Ext import           Data.Fixed-import qualified Data.Foldable as F+import qualified Data.Foldable                as F+import           Data.Geometry.BezierSpline import           Data.Geometry.Box-import           Data.Geometry.Ellipse(ellipseMatrix)+import           Data.Geometry.Ellipse        (ellipseMatrix) import           Data.Geometry.Ipe.Attributes import qualified Data.Geometry.Ipe.Attributes as IA-import           Data.Geometry.Ipe.Color (IpeColor(..))-import           Data.Geometry.Ipe.Types+import           Data.Geometry.Ipe.Color      (IpeColor (..)) import           Data.Geometry.Ipe.Path+import           Data.Geometry.Ipe.Types import           Data.Geometry.Ipe.Value import           Data.Geometry.LineSegment+import qualified Data.Geometry.Matrix         as Matrix import           Data.Geometry.Point-import           Data.Geometry.BezierSpline import           Data.Geometry.PolyLine-import           Data.Geometry.Polygon (Polygon, outerBoundary, holeList, asSimplePolygon)-import qualified Data.Geometry.Matrix as Matrix+import           Data.Geometry.Polygon        (Polygon, holeList, outerBoundary,+                                               outerBoundaryVector) import           Data.Geometry.Vector-import qualified Data.LSeq as LSeq-import           Data.List.NonEmpty (NonEmpty(..))-import           Data.Maybe (catMaybes, mapMaybe, fromMaybe)+import qualified Data.LSeq                    as LSeq+import           Data.List.NonEmpty           (NonEmpty (..))+import           Data.Maybe                   (catMaybes, fromMaybe, mapMaybe) import           Data.Ratio import           Data.RealNumber.Rational import           Data.Singletons-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Vinyl hiding (Label)+import           Data.Text                    (Text)+import qualified Data.Text                    as Text+import           Data.Vinyl                   hiding (Label) import           Data.Vinyl.Functor import           Data.Vinyl.TypeLevel-import           System.IO (hPutStrLn,stderr)-import           Text.XML.Expat.Format (format')+import           System.IO                    (hPutStrLn, stderr)+import           Text.XML.Expat.Format        (format') import           Text.XML.Expat.Tree  --------------------------------------------------------------------------------@@ -297,9 +298,9 @@     -- the polyline type guarantees that there is at least one point  instance IpeWriteText r => IpeWriteText (Polygon t () r) where-  ipeWriteText pg = fmap mconcat . traverse f $ asSimplePolygon pg : holeList pg+  ipeWriteText pg = fmap mconcat . traverse f $ pg^.outerBoundary : holeList pg     where-      f pg' = case pg'^..outerBoundary.traverse.core of+      f pg' = case pg'^..outerBoundaryVector.traverse.core of         (p : rest) -> unlines' . map ipeWriteText                     $ MoveTo p : map LineTo rest ++ [ClosePath]         _          -> Nothing

@@ -9,11 +9,8 @@ import           Data.Geometry.Ipe.Types import           Data.Geometry.QuadTree import           Data.Geometry.QuadTree.Cell-import           Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Text as T import           Data.Tree.Util (TreeNode(..))-import           Data.Vinyl.Notation-import           Data.Vinyl.Core --------------------------------------------------------------------------------  drawCell :: Fractional r => IpeOut (Cell r) Path r

@@ -10,5 +10,5 @@ drawTriangulation :: IpeOut (Triangulation p r) Group r drawTriangulation tr =   ipeGroup [ iO $ ipeLineSegment e-           | e <- map (uncurry ClosedLineSegment) . triangulationEdges $ tr+           | e <- map (uncurry ClosedLineSegment) . edgesAsPoints $ tr            ]