chart-svg 0.6.1.0 → 0.7.0.0

raw patch · 6 files changed

+141/−222 lines, 6 filesdep +harpiedep −adjunctionsdep −attoparsecdep −chart-svgdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: harpie

Dependencies removed: adjunctions, attoparsec, chart-svg, foldl, numhask-array

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• chart-svg.cabal +7/−11
• readme.md +45/−0
• readme.org +0/−44
• src/Data/Colour.hs +80/−154
• src/Data/Path.hs +4/−13

@@ -1,3 +1,8 @@+0.7+===++- switch to harpie+ 0.6.1 === 

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: chart-svg-version: 0.6.1.0+version: 0.7.0.0 license: BSD-3-Clause license-file: LICENSE copyright: Tony Day (c) 2017@@ -37,7 +37,7 @@ extra-doc-files:     ChangeLog.md     other/*.svg-    readme.org+    readme.md  source-repository head     type: git@@ -62,19 +62,16 @@     hs-source-dirs: src     build-depends:         , Color              >=0.3.2 && <0.4-        , adjunctions        >=4.0 && <5-        , attoparsec         >=0.13.2 && <0.15         , base               >=4.14 && <5         , bytestring         >=0.11.3 && <0.13         , containers         >=0.6 && <0.8         , cubicbezier        >=0.6 && <0.7         , flatparse          >=0.5 && <0.6-        , foldl              >=1.4 && <1.5         , formatn            >=0.3 && <0.4+        , harpie             >=0.1 && <0.2         , markup-parse       >=0.1 && <0.2         , mtl                >=2.2.2 && <2.4         , numhask            >=0.11 && <0.13-        , numhask-array      >=0.10 && <0.12         , numhask-space      >=0.10 && <0.12         , optics-core        >=0.4 && <0.5         , random             >=1.2 && <1.3@@ -98,11 +95,10 @@  test-suite doctests     import: ghc2021-stanza-    type: exitcode-stdio-1.0-    hs-source-dirs: test     main-is: doctests.hs-    ghc-options: -threaded+    hs-source-dirs: test     build-depends:-        , base-        , chart-svg+        , base             >=4.14 && <5         , doctest-parallel >=0.3 && <0.4+    ghc-options: -threaded+    type: exitcode-stdio-1.0

@@ -0,0 +1,45 @@++# Table of Contents++1.  [Usage](#org829f981)+2.  [Examples](#orge2856e9)++[![img](https://img.shields.io/hackage/v/chart-svg.svg)](https://hackage.haskell.org/package/chart-svg) [![img](https://github.com/tonyday567/chart-svg/workflows/haskell-ci/badge.svg)](https://github.com/tonyday567/chart-svg/actions?query=workflow%3Ahaskell-ci)++![img](other/banner.svg)++A charting library targetting SVG.+++<a id="org829f981"></a>++# Usage++    :r+    :set prompt "> "+    :set -XOverloadedLabels+    :set -XOverloadedStrings+    import Chart+    import Optics.Core+    lines = [[Point 0.0 1.0, Point 1.0 1.0, Point 2.0 5.0],[Point 0.0 0.0, Point 2.8 3.0],[Point 0.5 4.0, Point 0.5 0]]+    styles = (\c -> defaultLineStyle & #color .~ palette c & #size .~ 0.015) <$> [0..2]+    cs = zipWith (\s x -> LineChart s [x]) styles lines+    lineExample = mempty & #chartTree .~ named "line" cs & #hudOptions .~ defaultHudOptions :: ChartOptions+    writeChartOptions "other/usage.svg" lineExample++![img](other/usage.svg)++See the haddock documentation for a detailed overview.+++<a id="orge2856e9"></a>++# Examples++To redraw all the examples in Chart.Examples++    import Chart.Examples+    writeAllExamples++    ok+

@@ -1,44 +0,0 @@-#+TITLE: chart-svg--[[https://hackage.haskell.org/package/chart-svg][file:https://img.shields.io/hackage/v/chart-svg.svg]] [[https://github.com/tonyday567/chart-svg/actions?query=workflow%3Ahaskell-ci][file:https://github.com/tonyday567/chart-svg/workflows/haskell-ci/badge.svg]]--[[file:other/banner.svg]]--A charting library targetting SVG.--* Usage--#+begin_src haskell :file other/usage.svg :results output graphics file :exports both-:r-:set prompt "> "-:set -XOverloadedLabels-:set -XOverloadedStrings-import Chart-import Optics.Core-lines = [[Point 0.0 1.0, Point 1.0 1.0, Point 2.0 5.0],[Point 0.0 0.0, Point 2.8 3.0],[Point 0.5 4.0, Point 0.5 0]]-styles = (\c -> defaultLineStyle & #color .~ palette c & #size .~ 0.015) <$> [0..2]-cs = zipWith (\s x -> LineChart s [x]) styles lines-lineExample = mempty & #chartTree .~ named "line" cs & #hudOptions .~ defaultHudOptions :: ChartOptions-writeChartOptions "other/usage.svg" lineExample-#+end_src--#+RESULTS:-[[file:other/usage.svg]]--See the haddock documentation for a detailed overview.--* Examples--To redraw all the examples in Chart.Examples--#+begin_src haskell :results output-import Chart.Examples-writeAllExamples-#+end_src--#+RESULTS:-: ok----

@@ -1,9 +1,7 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE UndecidableInstances #-}  -- | Colour representations and combinations. module Data.Colour@@ -18,11 +16,7 @@     showOpacity,     opac',     opac,-    hex,     rgb,-    toHex,-    fromHex,-    unsafeFromHex,      -- * Palette colours     palette,@@ -36,7 +30,6 @@      -- * LCH model     LCH (..),-    pattern LCH,     lLCH',     cLCH',     hLCH',@@ -45,11 +38,9 @@     lch',     alpha',     RGB3 (..),-    pattern RGB3,     rgbd',     rgb32colour',     LAB (..),-    pattern LAB,     lcha2colour',     xy2ch', @@ -71,23 +62,19 @@ where  import Chart.Data-import Data.Attoparsec.Text qualified as A-import Data.Bifunctor import Data.Bool (bool) import Data.ByteString (ByteString)-import Data.Char-import Data.Either import Data.FormatN-import Data.Functor.Rep import Data.List qualified as List import Data.String.Interpolate-import Data.Text (Text, pack)+import Data.Text (Text) import Data.Text qualified as Text-import GHC.Exts import GHC.Generics hiding (prec) import Graphics.Color.Model as M hiding (LCH) import Graphics.Color.Space qualified as S-import NumHask.Array.Fixed+import Harpie.Fixed (Array, array, (!))+import Harpie.Fixed qualified as F+import Harpie.Shape (KnownNats) import Optics.Core import System.Random import System.Random.Stateful@@ -184,60 +171,10 @@ opac' :: Lens' Colour Double opac' = lens opac (\(Colour r g b _) o -> Colour r g b o) --- | Convert to CSS hex representation.-hex :: Colour -> Text-hex c = toHex c- -- | Sets RGB color but not opacity rgb :: Colour -> Colour -> Colour rgb (Colour r g b _) (Colour _ _ _ o) = Colour r g b o --- | Parse CSS hex text.-parseHex :: A.Parser (Color RGB Double)-parseHex =-  fmap toDouble-    . ( \((r, g), b) ->-          ColorRGB (fromIntegral r) (fromIntegral g) (fromIntegral b) :: Color RGB Word8-      )-    . (\(f, b) -> (f `divMod` (256 :: Int), b))-    . (`divMod` 256)-    <$> (A.string "#" *> A.hexadecimal)---- | Convert CSS hex to Colour-fromHex :: Text -> Either Text (Color RGB Double)-fromHex = first pack . A.parseOnly parseHex---- | Convert CSS hex to Colour, unsafely.-unsafeFromHex :: Text -> Color RGB Double-unsafeFromHex t = fromRight (ColorRGB 0 0 0) $ A.parseOnly parseHex t---- | Convert from 'Colour' to CSS hex (#xxxxxx)-toHex :: Colour -> Text-toHex c =-  "#"-    <> Text.justifyRight 2 '0' (hex' r)-    <> Text.justifyRight 2 '0' (hex' g)-    <> Text.justifyRight 2 '0' (hex' b)-  where-    (ColorRGBA r g b _) = fromIntegral . toWord8 <$> color' c--hex' :: Int -> Text-hex' n-  | n < 0 = "-" <> go (-n)-  | otherwise = go n-  where-    go n'-      | n' < 16 = hexDigit n'-      | otherwise = go (n' `quot` 16) <> hexDigit (n' `rem` 16)--hexDigit :: Int -> Text-hexDigit n-  | n <= 9 = Text.singleton $! i2d n-  | otherwise = Text.singleton $! toEnum (n + 87)--i2d :: Int -> Char-i2d x = chr (ord '0' + x)- -- | Select a Colour from the palette -- -- >>> palette 0@@ -313,6 +250,9 @@ transparent :: Colour transparent = Colour 0 0 0 0 +class ArrayAs f s a where+  arrayAs :: (KnownNats s) => Array s a -> f a+ -- | LCH colour representation -- -- oklab is a colour space being written into CSS specifications, that attempts to be ok at human-consistent colour representation. See:@@ -328,16 +268,10 @@ -- C: Chromacity, which ranges from 0 to around 0.32 or so. -- -- H: Hue, which ranges from 0 to 360-newtype LCH a = LCH' {lchArray :: Array '[3] a} deriving (Eq, Show, IsList, Functor)---- | LCH colour pattern-pattern LCH :: a -> a -> a -> LCH a-pattern LCH l c h <--  LCH' [l, c, h]-  where-    LCH l c h = LCH' [l, c, h]+data LCH a = LCH a a a deriving (Eq, Show, Functor) -{-# COMPLETE LCH #-}+instance ArrayAs LCH '[3] a where+  arrayAs a = LCH (a ! [0]) (a ! [1]) (a ! [2])  -- | Lightness lens for LCH lLCH' :: Lens' (LCH Double) Double@@ -365,25 +299,19 @@ -- | LCHA pattern pattern LCHA :: Double -> Double -> Double -> Double -> LCHA pattern LCHA l c h a <--  LCHA' (LCH' [l, c, h]) a+  LCHA' (LCH l c h) a   where-    LCHA l c h a = LCHA' (LCH' [l, c, h]) a+    LCHA l c h a = LCHA' (LCH l c h) a  {-# COMPLETE LCHA #-}  -- * RGB colour representation  -- | A type to represent the RGB triple, useful as an intermediary between 'Colour' and 'LCHA'-newtype RGB3 a = RGB3' {rgb3Array :: Array '[3] a} deriving (Eq, Show, IsList, Functor)---- | The RGB3 pattern-pattern RGB3 :: a -> a -> a -> RGB3 a-pattern RGB3 r g b <--  RGB3' [r, g, b]-  where-    RGB3 r g b = RGB3' [r, g, b]+data RGB3 a = RGB3 a a a deriving (Eq, Show, Functor) -{-# COMPLETE RGB3 #-}+instance ArrayAs RGB3 '[3] a where+  arrayAs a = RGB3 (a ! [0]) (a ! [1]) (a ! [2])  -- | Lens for conversion between Double and Word8 RGB triples. rgbd' :: Iso' (RGB3 Double) (RGB3 Word8)@@ -396,16 +324,10 @@ -- * LAB colour representation  -- | LAB colour representation. a is green-red and b is blue-yellow-newtype LAB a = LAB' {labArray :: Array '[3] a} deriving (Eq, Show, IsList, Functor)---- | LAB pattern-pattern LAB :: a -> a -> a -> LAB a-pattern LAB l a b <--  LAB' [l, a, b]-  where-    LAB l a b = LAB' [l, a, b]+data LAB a = LAB a a a deriving (Eq, Show, Functor) -{-# COMPLETE LAB #-}+instance ArrayAs LAB '[3] a where+  arrayAs a = LAB (a ! [0]) (a ! [1]) (a ! [2])  -- * Colour conversions @@ -415,14 +337,14 @@ -- -- >>> c0 = Colour 0.78 0.36 0.02 1.00 -- >>> view (re lcha2colour') c0--- LCHA' {_lch = LCH' {lchArray = [0.5969891006896103, 0.15793931531669247, 49.191113810479784]}, _alpha = 1.0}+-- LCHA' {_lch = LCH 0.5969891006896103 0.15793931531669247 49.191113810479784, _alpha = 1.0} -- -- >>> view (re lcha2colour' % lcha2colour') c0 -- Colour 0.78 0.36 0.02 1.00 -- -- >>> c1 = Colour 0.49 0.14 0.16 1 -- >>> view (re lcha2colour') c1--- LCHA' {_lch = LCH' {lchArray = [0.40115567099848914, 0.12279066817938503, 21.51476756026837]}, _alpha = 1.0}+-- LCHA' {_lch = LCH 0.40115567099848914 0.12279066817938503 21.51476756026837, _alpha = 1.0} -- -- >>> view (re lcha2colour' % lcha2colour') c1 -- Colour 0.49 0.14 0.16 1.00@@ -457,50 +379,52 @@ rgb2lab' :: Iso' (RGB3 Double) (LAB Double) rgb2lab' =   iso-    (\(RGB3' a) -> LAB' . xyz2lab_ . rgb2xyz_ $ a)-    (\(LAB' a) -> RGB3' . xyz2rgb_ . lab2xyz_ $ a)+    (\(RGB3 r g b) -> arrayAs . xyz2lab_ . rgb2xyz_ $ array [r, g, b])+    (\(LAB l a b) -> arrayAs . xyz2rgb_ . lab2xyz_ $ array [l, a, b])  -- * rgb to xyz -xyz2rgb_ :: Array '[3] Double -> Array '[3] Double-xyz2rgb_ a = fromList [r, g, b]+xyz2rgb_ :: F.Array '[3] Double -> F.Array '[3] Double+xyz2rgb_ a = array [r, g, b]   where-    (S.ColorSRGB r g b) = S.xyz2rgb (S.ColorXYZ (a `index` [0]) (a `index` [1]) (a `index` [2])) :: Color (S.SRGB 'S.NonLinear) Double+    (S.ColorSRGB r g b) = S.xyz2rgb (S.ColorXYZ (a ! [0]) (a ! [1]) (a ! [2])) :: Color (S.SRGB 'S.NonLinear) Double  -- >>> rgb2xyz_ [1,1,1] -- [0.9505, 1.0, 1.089]-rgb2xyz_ :: Array '[3] Double -> Array '[3] Double-rgb2xyz_ a = fromList [x, y, z]+rgb2xyz_ :: F.Array '[3] Double -> F.Array '[3] Double+rgb2xyz_ a = array [x, y, z]   where-    (S.ColorXYZ x y z) = S.rgb2xyz (S.ColorSRGB (a `index` [0]) (a `index` [1]) (a `index` [2])) :: Color (S.XYZ S.D65) Double+    (S.ColorXYZ x y z) = S.rgb2xyz (S.ColorSRGB (a ! [0]) (a ! [1]) (a ! [2])) :: Color (S.XYZ S.D65) Double  -- * xyz to lab -m1 :: Array '[3, 3] Double+m1 :: F.Array '[3, 3] Double m1 =-  [ 0.8189330101,-    0.3618667424,-    -0.1288597137,-    0.0329845436,-    0.9293118715,-    0.0361456387,-    0.0482003018,-    0.2643662691,-    0.6338517070-  ]+  array+    [ 0.8189330101,+      0.3618667424,+      -0.1288597137,+      0.0329845436,+      0.9293118715,+      0.0361456387,+      0.0482003018,+      0.2643662691,+      0.6338517070+    ] -m2 :: Array '[3, 3] Double+m2 :: F.Array '[3, 3] Double m2 =-  [ 0.2104542553,-    0.7936177850,-    -0.0040720468,-    1.9779984951,-    -2.4285922050,-    0.4505937099,-    0.0259040371,-    0.7827717662,-    -0.8086757660-  ]+  array+    [ 0.2104542553,+      0.7936177850,+      -0.0040720468,+      1.9779984951,+      -2.4285922050,+      0.4505937099,+      0.0259040371,+      0.7827717662,+      -0.8086757660+    ]  cubicroot :: (Floating a, Ord a) => a -> a cubicroot x = bool ((-1) * (-x) ** (1 / 3.0)) (x ** (1 / 3.0)) (x >= 0)@@ -519,39 +443,41 @@ -- -- >>> xyz2lab_ [0,0,1] -- [0.15260258004008057, -1.4149965510120839, -0.4489272035597538]-xyz2lab_ :: Array '[3] Double -> Array '[3] Double+xyz2lab_ :: F.Array '[3] Double -> F.Array '[3] Double xyz2lab_ xyz =-  dot sum (*) m2 (cubicroot <$> dot sum (*) m1 xyz)+  F.dot sum (*) m2 (cubicroot <$> F.dot sum (*) m1 xyz) -m1' :: Array '[3, 3] Double+m1' :: F.Array '[3, 3] Double m1' =-  [ 1.227013851103521026,-    -0.5577999806518222383,-    0.28125614896646780758,-    -0.040580178423280593977,-    1.1122568696168301049,-    -0.071676678665601200577,-    -0.076381284505706892869,-    -0.42148197841801273055,-    1.5861632204407947575-  ]+  array+    [ 1.227013851103521026,+      -0.5577999806518222383,+      0.28125614896646780758,+      -0.040580178423280593977,+      1.1122568696168301049,+      -0.071676678665601200577,+      -0.076381284505706892869,+      -0.42148197841801273055,+      1.5861632204407947575+    ] -m2' :: Array '[3, 3] Double+m2' :: F.Array '[3, 3] Double m2' =-  [ 0.99999999845051981432,-    0.39633779217376785678,-    0.21580375806075880339,-    1.0000000088817607767,-    -0.1055613423236563494,-    -0.063854174771705903402,-    1.0000000546724109177,-    -0.089484182094965759684,-    -1.2914855378640917399-  ]+  array+    [ 0.99999999845051981432,+      0.39633779217376785678,+      0.21580375806075880339,+      1.0000000088817607767,+      -0.1055613423236563494,+      -0.063854174771705903402,+      1.0000000546724109177,+      -0.089484182094965759684,+      -1.2914855378640917399+    ] -lab2xyz_ :: Array '[3] Double -> Array '[3] Double+lab2xyz_ :: F.Array '[3] Double -> F.Array '[3] Double lab2xyz_ lab =-  dot sum (*) m1' ((** 3.0) <$> dot sum (*) m2' lab)+  F.dot sum (*) m1' ((** 3.0) <$> F.dot sum (*) m2' lab)  -- * mixins 

@@ -9,6 +9,7 @@     pointPath,     movePath,     scalePath,+    projectPath,     projectPaths,     pathBoxes,     pathBox,@@ -44,8 +45,6 @@ where  import Chart.Data-import Control.Foldl qualified as L-import Control.Monad.State.Lazy import GHC.Generics import Geom2D.CubicBezier qualified as B import NumHask.Prelude@@ -107,16 +106,7 @@  -- | Project a list of connected PathDatas from one Rect (XY plave) to a new one. projectPaths :: Rect Double -> Rect Double -> [PathData Double] -> [PathData Double]-projectPaths new old ps =-  flip evalState zero $-    mapM-      ( \p -> do-          x <- get-          let d = projectPath new old x p-          put (pointPath d)-          pure d-      )-      ps+projectPaths new old ps = snd $ mapAccumL (\s a -> let d = projectPath new old s a in (pointPath d, d)) zero ps  -- | Project a PathData from one Rect (XY plave) to a new one. projectPath ::@@ -493,7 +483,8 @@ pathBoxes [] = Nothing pathBoxes (x : xs) =   Just $-    L.fold (L.Fold step begin snd) xs+    snd $+      foldl' step begin xs   where     begin :: (Point Double, Rect Double)     begin = (pointPath x, singleton (pointPath x))