packages feed

chart-svg 0.4.0 → 0.4.1.0

raw patch · 16 files changed

+170/−140 lines, 16 filesdep ~bytestringdep ~flatparsedep ~numhaskPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, flatparse, numhask, numhask-array, numhask-space

API changes (from Hackage documentation)

- Chart.Data: angle :: Direction coord dir => coord -> dir
- Chart.Data: basis :: Norm a b => a -> a
- Chart.Data: class (Additive coord, Multiplicative coord, Additive dir, Multiplicative dir) => Direction coord dir | coord -> dir
- Chart.Data: class (Additive a, Multiplicative b, Additive b) => Norm a b | a -> b
- Chart.Data: class (Additive a, Multiplicative a) => Signed a
- Chart.Data: norm :: Norm a b => a -> b
- Chart.Data: ray :: Direction coord dir => dir -> coord
- Chart.Data: sign :: Signed a => a -> a
- Chart.Surface: surfacefl :: (Point Double -> Double) -> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])
+ Chart.Data: magnitude :: Basis a => a -> Mag a
+ Chart.Surface: surfaceLegendChart :: Range Double -> SurfaceLegendOptions -> ChartTree
- Chart.Data: abs :: Signed a => a -> a
+ Chart.Data: abs :: Absolute a => a -> a
- Data.Path: CubicPolar :: Point a -> Point a -> Polar a a -> Polar a a -> CubicPolar a
+ Data.Path: CubicPolar :: Point a -> Point a -> Polar a -> Polar a -> CubicPolar a
- Data.Path: QuadPolar :: Point a -> Point a -> Polar a a -> QuadPolar a
+ Data.Path: QuadPolar :: Point a -> Point a -> Polar a -> QuadPolar a
- Data.Path: [cpolControl1] :: CubicPolar a -> Polar a a
+ Data.Path: [cpolControl1] :: CubicPolar a -> Polar a
- Data.Path: [cpolControl2] :: CubicPolar a -> Polar a a
+ Data.Path: [cpolControl2] :: CubicPolar a -> Polar a
- Data.Path: [qpolControl] :: QuadPolar a -> Polar a a
+ Data.Path: [qpolControl] :: QuadPolar a -> Polar a
- Data.Path: arcPosition :: (Ord a, Signed a, TrigField a) => ArcCentroid a -> ArcPosition a
+ Data.Path: arcPosition :: (Ord a, Absolute a, TrigField a) => ArcCentroid a -> ArcPosition a
- Data.Path: ellipse :: (Direction b a, Affinity b a, TrigField a) => b -> b -> a -> a -> b
+ Data.Path: ellipse :: (Direction b, Dir b ~ a, Affinity b a, TrigField a) => b -> b -> a -> a -> b

Files

chart-svg.cabal view
@@ -1,12 +1,12 @@-cabal-version:   2.4+cabal-version:   3.0 name:            chart-svg-version:         0.4.0+version:         0.4.1.0 synopsis:        Charting library targetting SVGs. description:   This package provides a charting library targetting SVG as the rendered output.-  .+   == Usage-  .+   >>> :set -XOverloadedLabels   >>> :set -XOverloadedStrings   >>> import Chart@@ -16,9 +16,9 @@   >>> let cs = zipWith (\s x -> LineChart s [x]) styles lines   >>> let lineExample = mempty & #charts .~ named "line" cs & #hudOptions .~ defaultHudOptions :: ChartOptions   >>> writeChartOptions "other/usage.svg" lineExample-  .+   ![usage example](docs/other/usage.svg)-  .+   See "Chart" for a broad overview of concepts, and "Chart.Examples" for practical examples.  category:        charts@@ -31,14 +31,81 @@ license-file:    LICENSE build-type:      Simple extra-doc-files: other/*.svg-tested-with:-  GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.2.5 || ==9.4.4+tested-with:     GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2  source-repository head   type:     git   location: https://github.com/tonyday567/chart-svg +common ghc2021-stanza+  if impl(ghc >=9.2)+    default-language:+      GHC2021+  if impl(ghc <9.2)+    default-language:+      Haskell2010+    default-extensions:+      BangPatterns+      BinaryLiterals+      ConstrainedClassMethods+      ConstraintKinds+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DoAndIfThenElse+      EmptyCase+      EmptyDataDecls+      EmptyDataDeriving+      ExistentialQuantification+      ExplicitForAll+      FlexibleContexts+      FlexibleInstances+      ForeignFunctionInterface+      GADTSyntax+      GeneralisedNewtypeDeriving+      HexFloatLiterals+      ImplicitPrelude+      InstanceSigs+      KindSignatures+      MonomorphismRestriction+      MultiParamTypeClasses+      NamedFieldPuns+      NamedWildCards+      NumericUnderscores+      PatternGuards+      PolyKinds+      PostfixOperators+      RankNTypes+      RelaxedPolyRec+      ScopedTypeVariables+      StandaloneDeriving+      StarIsType+      TraditionalRecordSyntax+      TupleSections+      TypeApplications+      TypeOperators+      TypeSynonymInstances+  if impl(ghc <9.2) && impl(ghc >=8.10)+    default-extensions:+      ImportQualifiedPost+      StandaloneKindSignatures++common ghc-options-stanza+  ghc-options:+    -Wall+    -Wcompat+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wredundant-constraints+    -Widentities+    -Wpartial-fields+ library+  import: ghc2021-stanza+  import: ghc-options-stanza   exposed-modules:     Chart     Chart.Bar@@ -61,16 +128,16 @@     adjunctions ^>=4.4,     attoparsec >=0.13.2 && <0.15,     base >=4.7 && <5,-    bytestring ^>=0.11.3,+    bytestring >=0.11.3 && <0.13,     containers ^>=0.6,     cubicbezier ^>=0.6,-    flatparse >= 0.4 && <0.5,+    flatparse >=0.4 && <0.6,     foldl ^>=1.4,     formatn >=0.3 && < 0.4,     mtl >=2.2.2 && <2.4,-    numhask ^>=0.10,-    numhask-array ^>=0.10,-    numhask-space ^>=0.10,+    numhask ^>=0.11,+    numhask-array ^>=0.11,+    numhask-space ^>=0.11,     optics-core ^>=0.4,     random ^>=1.2.1,     string-interpolate ^>=0.3,@@ -78,27 +145,18 @@     time >=1.9 && <2,     tree-diff >=0.3 && <0.4, -  default-language:   Haskell2010-  default-extensions: StrictData-  ghc-options:-    -Wall -Wcompat -Wincomplete-record-updates-    -Wincomplete-uni-patterns -Wredundant-constraints- test-suite test+  import: ghc2021-stanza+  import: ghc-options-stanza   type: exitcode-stdio-1.0   main-is: test.hs-  default-language:   Haskell2010   hs-source-dirs:     test   build-depends:     base >=4.7 && <5,-    bytestring ^>=0.11.3,+    bytestring >=0.11.3 && <0.13,     chart-svg,-    flatparse >= 0.4.0 && <0.5,+    flatparse >=0.4 && <0.6,     tasty >=1.2 && <1.5,     tasty-golden ^>=2.3.1.1,     tree-diff >=0.3 && <0.4,--  ghc-options:-    -Wall -Wcompat -Wincomplete-record-updates-    -Wincomplete-uni-patterns -Wredundant-constraints
src/Chart.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_HADDOCK prune #-}  -- | A haskell Charting library targetting SVG.
src/Chart/Bar.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-}  -- | Bar charts module Chart.Bar
src/Chart/Data.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE RebindableSyntax #-}-{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_HADDOCK prune #-}  -- | Data primitives and utilities ----- Whilst the library makes use of <https://hackage.haskell.org/package/numhask numhask>, it does not re-export, to avoid clashes with Prelude, with the exception of 'zero', 'one', 'angle', 'norm' & 'abs'.+-- Whilst the library makes use of <https://hackage.haskell.org/package/numhask numhask>, it does not re-export, to avoid clashes with Prelude, with the exception of 'zero', 'one', 'angle' & 'abs'. -- -- 'Rect' and 'Point', from <https://hackage.haskell.org/package/numhask-space numhask-space>, make up the base elements of many chart primitives, and all of numhask-space is re-exported. module Chart.Data@@ -18,14 +17,12 @@      -- * NumHask Exports -    ---     -- | Note that (+) and (*) from numhask are not actually re-exported.     Multiplicative (one),     Additive (zero),-    Direction (..),-    Norm (..),-    Signed (..),+    abs,+    angle,+    magnitude,      -- * Re-exports     module NumHask.Space,
src/Chart/Examples.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -Wall #-}  -- | Examples of chart construction. module Chart.Examples@@ -49,9 +47,10 @@ import Data.Bool import Data.ByteString (ByteString) import Data.Function+import Data.Maybe import Data.String.Interpolate import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Time import Optics.Core import Prelude hiding (abs)@@ -515,16 +514,19 @@     & #charts .~ named "surface" cs     & #markupOptions .~ (defaultMarkupOptions & #cssOptions % #shapeRendering .~ UseCssCrisp)   where+    -- FIXME: surface legends are broken as.+    -- & #hudOptions % #legends .~ [(30,defaultLegendOptions & #content .~ [("", foldOf charts' $ surfaceLegendChart rangef (defaultSurfaceLegendOptions dark "text"))])]+     grain = Point 100 100     r = one     f = fst . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10     evenColors = trimColour . over lightness' (const 0.55) . palette1 <$> [0 .. 5]+    (cs, _) = surfacef f so     so =       defaultSurfaceOptions         & #soGrain .~ grain         & #soRange .~ r         & #soStyle % #surfaceColors .~ evenColors-    (cs, _) = surfacef f so  -- | arrow example --@@ -566,9 +568,9 @@     gchart s r' p = GlyphChart (gs s r') [p]      tail' :: Point Double -> Double-    tail' = max 0.05 . min 0.02 . (* 0.01) . (/ avmag) . norm+    tail' = max 0.05 . min 0.02 . (* 0.01) . (/ avmag) . magnitude -    avmag = sum (norm . f <$> ps) / fromIntegral (length ps)+    avmag = sum (magnitude . f <$> ps) / fromIntegral (length ps)  -- | function for testing --
src/Chart/FlatParse.hs view
@@ -1,17 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}  -- | Lower-level flatparse parsers
src/Chart/Hud.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -Wall #-}  -- | A hud stands for <https://en.wikipedia.org/wiki/Head-up_display head-up display>, and is a collective noun used to name chart elements that assist in data interpretation or otherwise annotate and decorate data. --@@ -84,14 +81,14 @@ import Data.Colour import Data.Foldable hiding (sum) import Data.FormatN-import qualified Data.List as List+import Data.List qualified as List import Data.Maybe import Data.Path import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Tuple import GHC.Generics hiding (to)-import qualified NumHask.Prelude as NH+import NumHask.Prelude qualified as NH import Optics.Core import Prelude @@ -422,7 +419,7 @@         bool (space1 ticks0) Nothing (e == NoTickExtend)       )       where-        ticks0 = gridSensible OuterPos (e == NoTickExtend) r (fromIntegral n :: Integer)+        ticks0 = gridSensible OuterPos (e == NoTickExtend) r n     TickExact f n -> (zip ticks0 (formatNs f ticks0), Nothing)       where         ticks0 = grid OuterPos r n@@ -882,7 +879,7 @@     TickNone -> []     TickRound f n e -> zip (project r d <$> ticks0) (formatNs f ticks0)       where-        ticks0 = gridSensible OuterPos (e == NoTickExtend) r (fromIntegral n :: Integer)+        ticks0 = gridSensible OuterPos (e == NoTickExtend) r n     TickExact f n -> zip (project r d <$> ticks0) (formatNs f ticks0)       where         ticks0 = grid OuterPos r n
src/Chart/Markup.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TupleSections #-}  -- | An intermediary representation not unlike SVG or XML but only forming a subset of these standards. module Chart.Markup@@ -44,7 +42,7 @@ import Data.Colour import Data.FormatN import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe import Data.Path import Data.Path.Parser@@ -477,7 +475,6 @@ -- > fillSwitch (color1, color2) "dark" "stuff" -- -- ... will default to color1 for elements of the "stuff" class, but switch to color2 if "dark" mode is preferred by the user.--- fillSwitch :: (Colour, Colour) -> ByteString -> ByteString -> ByteString fillSwitch (colorNormal, colorPrefer) prefer item =   [i|
src/Chart/Markup/Parser.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}  -- | Much of the parsing logic is based on the XML productions found in https://www.w3.org/TR/xml/#NT-content --@@ -51,7 +49,7 @@ import Data.ByteString (ByteString) import Data.String.Interpolate import FlatParse.Basic hiding (cut)-import qualified FlatParse.Basic.Text as T+import FlatParse.Basic.Text qualified as T import GHC.Generics import Prelude 
src/Chart/Primitive.hs view
@@ -1,10 +1,6 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-}  -- | Base 'Chart' and 'ChartTree' types and support module Chart.Primitive@@ -65,7 +61,7 @@ import Data.Text (Text) import Data.Tree import GHC.Generics-import qualified NumHask.Prelude as NH+import NumHask.Prelude qualified as NH import Optics.Core import Prelude 
src/Chart/Style.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-}  -- | Stylistic or syntactical options for chart elements. module Chart.Style@@ -50,13 +48,13 @@ import Chart.Data import Data.ByteString (ByteString) import Data.Colour-import qualified Data.List as List+import Data.List qualified as List import Data.Maybe import Data.Path import Data.Path.Parser import Data.String import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import GHC.Generics import Optics.Core import Prelude
src/Chart/Surface.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-}  -- | Surface chart combinators. --@@ -15,9 +13,9 @@     mkSurfaceData,     surfaces,     surfacef,-    surfacefl,     SurfaceLegendOptions (..),     defaultSurfaceLegendOptions,+    surfaceLegendChart,     surfaceAxisOptions,   ) where@@ -96,12 +94,13 @@   Grid (Rect Double) ->   [Colour] ->   ([SurfaceData], Range Double)-mkSurfaceData f r g cs = (zipWith SurfaceData rects (flip mixes cs <$> proj), unsafeSpace1 vs)+mkSurfaceData f r g cs = (zipWith SurfaceData rects (flip mixes cs <$> proj), rx)   where     ps = gridF f r g     rects = fst <$> ps     vs = snd <$> ps-    proj = project (unsafeSpace1 vs :: Range Double) (Range 0 1) <$> vs+    rx = unsafeSpace1 vs :: Range Double+    proj = project rx (Range 0 1) <$> vs  -- | Create a surface chart from a function. surfacef :: (Point Double -> Double) -> SurfaceOptions -> ([Chart], Range Double)@@ -112,15 +111,6 @@       (cfg ^. #soRange)       (cfg ^. #soGrain)       (toList $ cfg ^. #soStyle % #surfaceColors)---- | Create a surface chart and accompanying legend from a function.-surfacefl :: (Point Double -> Double) -> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])-surfacefl f po slo =-  ( cs,-    [Hud 10 (legendHud (slo ^. #sloLegendOptions) (surfaceLegendChart dr slo))]-  )-  where-    (cs, dr) = surfacef f po  -- | Legend specialization for a surface chart. data SurfaceLegendOptions = SurfaceLegendOptions
src/Data/Colour.hs view
@@ -1,14 +1,9 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wall #-}  -- | Colour representations and combinations. module Data.Colour@@ -76,7 +71,7 @@ where  import Chart.Data-import qualified Data.Attoparsec.Text as A+import Data.Attoparsec.Text qualified as A import Data.Bifunctor import Data.Bool (bool) import Data.ByteString (ByteString)@@ -84,14 +79,14 @@ import Data.Either import Data.FormatN import Data.Functor.Rep-import qualified Data.List as List+import Data.List qualified as List import Data.String.Interpolate import Data.Text (Text, pack)-import qualified Data.Text as Text+import Data.Text qualified as Text import GHC.Exts import GHC.Generics hiding (prec) import Graphics.Color.Model as M hiding (LCH)-import qualified Graphics.Color.Space as S+import Graphics.Color.Space qualified as S import NumHask.Algebra.Metric import NumHask.Array.Fixed import Optics.Core@@ -438,12 +433,12 @@  -- * lab to lch --- | Lens between generic XY color representations and CH ones, which are polar version of the XY.+-- | Lens between generic XY color representations and CH ones, which are polar versions of the XY. xy2ch' :: Iso' (Double, Double) (Double, Double) xy2ch' =   iso-    (\(x, y) -> (norm (Point x y), 180 / pi * mod_ (angle (Point x y)) (2 * pi)))-    (\(c, h) -> let (Point x y) = coord (Polar c (pi / 180 * h)) in (x, y))+    (\(x, y) -> (magnitude (Point x y), 180 / pi * mod_ (angle (Point x y)) (2 * pi)))+    (\(c, h) -> let (Point x y) = fmap (c *) (ray (pi / 180 * h)) in (x, y))  mod_ :: Double -> Double -> Double mod_ x d = x - fromIntegral (floor (x / d) :: Integer) * d@@ -656,9 +651,9 @@ showSwatches :: Text -> Text -> [(Text, Colour)] -> Text showSwatches pref suff hs =   [i|<div>-#{pref}-#{divs}-#{suff}+ #{pref}+ #{divs}+ #{suff} </div> |]   where
src/Data/Path.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RebindableSyntax #-}-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# LANGUAGE TypeFamilies #-}  -- | SVG path manipulation module Data.Path@@ -46,10 +44,10 @@ where  import Chart.Data-import qualified Control.Foldl as L+import Control.Foldl qualified as L import Control.Monad.State.Lazy import GHC.Generics-import qualified Geom2D.CubicBezier as B+import Geom2D.CubicBezier qualified as B import NumHask.Prelude  -- $setup@@ -199,7 +197,7 @@ arcCentroid :: (Ord a, FromInteger a, TrigField a, ExpField a) => ArcPosition a -> ArcCentroid a arcCentroid (ArcPosition p1@(Point x1 y1) p2@(Point x2 y2) (ArcInfo rad phi' large' clockwise')) = ArcCentroid c (Point rx ry) phi' ang1 angd   where-    (Point x1' y1') = rotateP (-phi') ((p1 - p2) /. two)+    (Point x1' y1') = rotateP (-phi') ((p1 - p2) |/ two)     (Point rx' ry') = rad     l = x1' ** 2 / rx' ** 2 + y1' ** 2 / ry' ** 2     (rx, ry) = bool (rx', ry') (rx' * sqrt l, ry' * sqrt l) (l > 1)@@ -232,7 +230,7 @@ -- - angle diff is pi and large is True -- -- - radii are less than they should be and thus get scaled up.-arcPosition :: (Ord a, Signed a, TrigField a) => ArcCentroid a -> ArcPosition a+arcPosition :: (Ord a, Absolute a, TrigField a) => ArcCentroid a -> ArcPosition a arcPosition (ArcCentroid c r phi' ang1 angd) =   ArcPosition p1 p2 (ArcInfo r phi' large' clockwise')   where@@ -255,7 +253,7 @@ -- > c + (rotate phi |. (r * ray theta)) -- -- See also: [wolfram](https://mathworld.wolfram.com/Ellipse.html)-ellipse :: (Direction b a, Affinity b a, TrigField a) => b -> b -> a -> a -> b+ellipse :: (Direction b, Dir b ~ a, Affinity b a, TrigField a) => b -> b -> a -> a -> b ellipse c r phi' theta = c + (rotate phi' |. (r * ray theta))  -- | compute the bounding box for an arcBox@@ -314,18 +312,18 @@     -- | ending point     qpolEnd :: Point a,     -- | control point in terms of distance from and angle to the qp0 - qp2 line-    qpolControl :: Polar a a+    qpolControl :: Polar a   }   deriving (Eq, Show, Generic)  -- | Convert from a positional to a polar representation of a cubic bezier. -- -- >>> quadPolar (QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1)))--- QuadPolar {qpolStart = Point 0.0 0.0, qpolEnd = Point 1.0 1.0, qpolControl = Polar {magnitude = 2.1213203435596424, direction = -0.7853981633974483}}+-- QuadPolar {qpolStart = Point 0.0 0.0, qpolEnd = Point 1.0 1.0, qpolControl = Polar {radial = 2.1213203435596424, azimuth = -0.7853981633974483}} quadPolar :: (Eq a, TrigField a, ExpField a) => QuadPosition a -> QuadPolar a quadPolar (QuadPosition start' end control) = QuadPolar start' end control'   where-    mp = (start' + end) /. two+    mp = (start' + end) |/ two     control' = polar (control - mp)  -- | Convert from a polar to a positional representation of a quadratic bezier.@@ -338,7 +336,7 @@ quadPosition :: (TrigField a) => QuadPolar a -> QuadPosition a quadPosition (QuadPolar start' end control) = QuadPosition start' end control'   where-    control' = coord control + (start' + end) /. two+    control' = coord control + (start' + end) |/ two  -- | The quadratic bezier equation --@@ -346,9 +344,16 @@ -- Point 0.9999999933333332 -0.33333333333333326 quadBezier :: (FromInteger a, ExpField a) => QuadPosition a -> a -> Point a quadBezier (QuadPosition start' end control) theta =-  (1 - theta) ^ 2 .* start'-    + 2 * (1 - theta) * theta .* control-    + theta ^ 2 .* end+  (1 - theta)+    ^ 2+    *| start'+    + 2+    * (1 - theta)+    * theta+    *| control+    + theta+    ^ 2+    *| end  -- | QuadPosition turning points. --@@ -357,7 +362,7 @@ quadDerivs :: QuadPosition Double -> [Double] quadDerivs (QuadPosition start' end control) = [x', y']   where-    (Point detx dety) = start' - 2 .* control + end+    (Point detx dety) = start' - 2 *| control + end     x' = bool ((_x start' - _x control) / detx) (2 * (_x control - _x start')) (detx == 0)     y' = bool ((_y start' - _y control) / dety) (2 * (_y control - _y start')) (dety == 0) @@ -393,9 +398,9 @@     -- | ending point     cpolEnd :: Point a,     -- | control point in terms of distance from and angle to the start end line-    cpolControl1 :: Polar a a,+    cpolControl1 :: Polar a,     -- | control point in terms of distance from and angle to the start end line-    cpolControl2 :: Polar a a+    cpolControl2 :: Polar a   }   deriving (Eq, Show, Generic) @@ -405,13 +410,13 @@ -- > cubicPolar . cubicPosition == id -- -- >>> cubicPolar (CubicPosition (Point 0 0) (Point 1 1) (Point 1 (-1)) (Point 0 2))--- CubicPolar {cpolStart = Point 0.0 0.0, cpolEnd = Point 1.0 1.0, cpolControl1 = Polar {magnitude = 1.1180339887498947, direction = -1.2490457723982544}, cpolControl2 = Polar {magnitude = 1.1180339887498947, direction = 1.8925468811915387}}+-- CubicPolar {cpolStart = Point 0.0 0.0, cpolEnd = Point 1.0 1.0, cpolControl1 = Polar {radial = 1.1180339887498947, azimuth = -1.2490457723982544}, cpolControl2 = Polar {radial = 1.1180339887498947, azimuth = 1.8925468811915387}} cubicPolar :: (Eq a, ExpField a, TrigField a) => CubicPosition a -> CubicPolar a cubicPolar (CubicPosition start' end control1 control2) = CubicPolar start' end control1' control2'   where-    mp = (start' + end) /. two-    control1' = polar $ (control1 - mp) /. norm (end - start')-    control2' = polar $ (control2 - mp) /. norm (end - start')+    mp = (start' + end) |/ two+    control1' = polar $ (control1 - mp) |/ magnitude (end - start')+    control2' = polar $ (control2 - mp) |/ magnitude (end - start')  -- | Convert from a polar to a positional representation of a cubic bezier. --@@ -423,8 +428,8 @@ cubicPosition :: (Eq a, TrigField a, ExpField a) => CubicPolar a -> CubicPosition a cubicPosition (CubicPolar start' end control1 control2) = CubicPosition start' end control1' control2'   where-    control1' = norm (end - start') .* coord control1 + (start' + end) /. two-    control2' = norm (end - start') .* coord control2 + (start' + end) /. two+    control1' = magnitude (end - start') *| coord control1 + (start' + end) |/ two+    control2' = magnitude (end - start') *| coord control2 + (start' + end) |/ two  -- | The cubic bezier equation --@@ -432,10 +437,22 @@ -- Point 0.6767766952966369 1.2071067811865475 cubicBezier :: (FromInteger a, TrigField a) => CubicPosition a -> a -> Point a cubicBezier (CubicPosition start' end control1 control2) theta =-  (1 - theta) ^ 3 .* start'-    + 3 * (1 - theta) ^ 2 * theta .* control1-    + 3 * (1 - theta) * theta ^ 2 .* control2-    + theta ^ 3 .* end+  (1 - theta)+    ^ 3+    *| start'+    + 3+    * (1 - theta)+    ^ 2+    * theta+    *| control1+    + 3+    * (1 - theta)+    * theta+    ^ 2+    *| control2+    + theta+    ^ 3+    *| end  -- | Turning point positions for a CubicPosition (0,1 or 2) --@@ -504,6 +521,6 @@ projectArcPosition new old (ArcPosition _ _ (ArcInfo (Point rx ry) phi' l cl)) = ArcInfo (Point rx'' ry'') phi' l cl   where     rx' = rotateP phi' (Point rx zero)-    rx'' = norm $ rx' * width new / width old+    rx'' = magnitude $ rx' * width new / width old     ry' = rotateP phi' (Point zero ry)-    ry'' = norm $ ry' * width new / width old+    ry'' = magnitude $ ry' * width new / width old
src/Data/Path/Parser.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RebindableSyntax #-}-{-# HLINT ignore "Use unwords" #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -Wall #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}  -- | SVG path manipulation module Data.Path.Parser@@ -35,7 +30,7 @@ import FlatParse.Basic import GHC.Generics import GHC.OverloadedLabels-import NumHask.Prelude+import NumHask.Prelude hiding (optional, (<|>)) import Optics.Core hiding ((<|))  -- $parsing@@ -239,7 +234,6 @@     <> pp' control     <> " "     <> pp' p--- FIXME: check why y doesn't need swapping into SVG coord system toPathAbsolute (ArcP (ArcInfo (Point x y) phi' l sw) x2) =   "A "     <> pv' x
test/test.hs view
@@ -7,11 +7,11 @@ import Chart.Examples import Chart.Markup import Chart.Markup.Parser-import qualified Data.ByteString as BS+import Data.ByteString qualified as BS import Data.Foldable import Data.Maybe import Data.TreeDiff-import qualified Data.TreeDiff.OMap as O+import Data.TreeDiff.OMap qualified as O import FlatParse.Basic import GHC.Exts import Test.Tasty (TestTree, defaultMain, testGroup)