diagrams-lib 1.4.7 → 1.5.1
raw patch · 5 files changed
Files
- CHANGELOG.md +30/−0
- diagrams-lib.cabal +5/−6
- src/Diagrams/Backend/CmdLine.hs +5/−135
- src/Diagrams/Trail.hs +11/−0
- src/Diagrams/TwoD/Segment.hs +26/−16
CHANGELOG.md view
@@ -1,3 +1,33 @@+## [v1.5.1](https://github.com/diagrams/diagrams-lib/tree/v1.5.1) (2025-12-02)++- New `Semigroup` instance for located lines (i.e. `Located (Trail'+ Line v n)`), which adds an extra segment from the end of the first+ to the start of the second.++## [v1.5.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.5.0.1) (2025-08-25)++- Fix bug in `bezierFindRoot` that caused diagrams to hang when+ computing the trace of certain degenerate Bezier curves. See+ https://github.com/diagrams/diagrams-contrib/issues/91 .++## [v1.5-r2](https://github.com/diagrams/diagrams-lib/tree/v1.5-r2) (2025-06-12)++- Allow `optparse-applicative-0.19`++## [v1.5-r1](https://github.com/diagrams/diagrams-lib/tree/v1.5-r1) (2025-05-17)++- Allow `monoid-extras-0.7`++## [v1.5](https://github.com/diagrams/diagrams-lib/tree/v1.5) (2025-02-13)++- Allow `base-4.21` and test on GHC 9.12+- Remove looped compilation mode options ([#372](https://github.com/diagrams/diagrams-lib/pull/372))+ - This allows us to remove the `fsnotify` dependency, which in+ turn allows compiling diagrams to Wasm.+ - To recover similar functionality (automatically recompiling+ every time a source file changes), try an external tool like+ `ghcid` or `ghciwatch`, or, more generically, `entr`.+ ## [v1.4.7](https://github.com/diagrams/diagrams-lib/tree/v1.4.7) (2024-10-26) - Switch to `data-default-0.8` instead of `data-default-class`
diagrams-lib.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-lib-Version: 1.4.7+Version: 1.5.1 Synopsis: Embedded domain-specific language for declarative graphics Description: Diagrams is a flexible, extensible EDSL for creating graphics of many types. Graphics can be created@@ -21,7 +21,7 @@ Cabal-version: 1.18 Extra-source-files: diagrams/*.svg Extra-doc-files: CHANGELOG.md, README.markdown, diagrams/*.svg-Tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1+Tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1 || ==9.12.1 Source-repository head type: git location: http://github.com/diagrams/diagrams-lib.git@@ -101,11 +101,11 @@ Diagrams.TwoD.Vector, Diagrams.Util other-modules: Linear.Vector.Compat- Build-depends: base >= 4.9 && < 4.21,+ Build-depends: base >= 4.9 && < 4.22, containers >= 0.3 && < 0.8, array >= 0.3 && < 0.6, semigroups >= 0.3.4 && < 0.21,- monoid-extras >= 0.6 && < 0.7,+ monoid-extras >= 0.6 && < 0.8, dual-tree >= 0.2 && < 0.3, diagrams-core >= 1.4 && < 1.6, diagrams-solve >= 0.1 && < 0.2,@@ -116,7 +116,7 @@ intervals >= 0.7 && < 0.10, lens >= 5.1 && < 5.4, tagged >= 0.7 && < 0.9,- optparse-applicative >= 0.11 && < 0.19,+ optparse-applicative >= 0.11 && < 0.20, filepath >= 1.4 && < 1.6, JuicyPixels >= 3.3.4 && < 3.4, hashable >= 1.1 && < 1.6,@@ -124,7 +124,6 @@ adjunctions >= 4.0 && < 5.0, distributive >=0.2.2 && < 1.0, process >= 1.1 && < 1.7,- fsnotify >= 0.4 && < 0.5, directory >= 1.2 && < 1.4, unordered-containers >= 0.2 && < 0.3, text >= 0.7.1 && < 2.2,
src/Diagrams/Backend/CmdLine.hs view
@@ -50,12 +50,6 @@ , diagramAnimOpts , fpu - -- ** Loop options- , DiagramLoopOpts(..)- , diagramLoopOpts- , loop- , src- -- * Parsing , Parseable(..) , readHexColor@@ -70,19 +64,17 @@ -- ** helper functions for implementing @mainRender@ , defaultAnimMainRender , defaultMultiMainRender- , defaultLoopRender ) where import Control.Lens (Lens', makeLenses, (&), (.~), (^.)) import Diagrams.Animation import Diagrams.Attributes import Diagrams.Core hiding (output)-import Diagrams.Util import Options.Applicative import Options.Applicative.Types (readerAsk) -import Control.Monad (forM_, forever, unless, when)+import Control.Monad (forM_) -- MonadFail comes from Prelude in base-4.13 and up #if !MIN_VERSION_base(4,13,0)@@ -96,27 +88,12 @@ import Data.Colour.SRGB import Data.Data import Data.Functor.Identity-import Data.IORef import Data.Kind (Type)-import Data.List (delete)-import Data.Maybe (fromMaybe) import Data.Monoid import Numeric -import Control.Concurrent (threadDelay)-import System.Directory (canonicalizePath)-import System.Environment (getArgs, getProgName)-import System.Exit (ExitCode (..))-import System.FilePath (addExtension, dropExtension,- replaceExtension, splitExtension,- takeDirectory, takeFileName, (</>))-import System.FSNotify (defaultConfig,- eventTime, watchDir,- withManagerConf, confWatchMode, WatchMode(..))-import System.FSNotify.Devel (existsEvents)-import System.Info (os)-import System.IO (hFlush, stdout)-import System.Process (readProcessWithExitCode)+import System.Environment (getProgName)+import System.FilePath (addExtension, splitExtension) import Text.Printf @@ -149,14 +126,6 @@ makeLenses ''DiagramAnimOpts --- | Extra options for command-line looping.-data DiagramLoopOpts = DiagramLoopOpts- { _loop :: Bool -- ^ Flag to indicate that the program should loop creation.- , _src :: Maybe FilePath -- ^ File path for the source file to recompile.- }--makeLenses ''DiagramLoopOpts- -- | Command line parser for 'DiagramOpts'. -- Width is option @--width@ or @-w@. -- Height is option @--height@ or @-h@ (note we change help to be @-?@ due to this).@@ -199,16 +168,6 @@ <> value 30.0 <> help "Frames per unit time (for animations)") --- | CommandLine parser for 'DiagramLoopOpts'--- Loop is @--loop@ or @-l@.--- Source is @--src@ or @-s@.-diagramLoopOpts :: Parser DiagramLoopOpts-diagramLoopOpts = DiagramLoopOpts- <$> switch (long "loop" <> short 'l' <> help "Run in a self-recompiling loop")- <*> (optional . strOption)- ( long "src" <> short 's'- <> help "Source file to watch")- -- | A hidden \"helper\" option which always fails. -- Taken from Options.Applicative.Extra but without the -- short option 'h'. We want the 'h' for Height.@@ -277,11 +236,6 @@ instance Parseable DiagramAnimOpts where parser = diagramAnimOpts --- | Parse 'DiagramLoopOpts' using the 'diagramLoopOpts' parser.-instance Parseable DiagramLoopOpts where- parser = diagramLoopOpts-- -- | Parse @'Colour' Double@ as either a named color from "Data.Colour.Names" -- or a hexadecimal color. instance Parseable (Colour Double) where@@ -529,9 +483,8 @@ -- be output for each second (unit time) of animation. -- -- This function requires a lens into the structure that the particular backend--- uses for it's diagram base case. If @MainOpts (QDiagram b v n Any) ~ DiagramOpts@--- then this lens will simply be 'output'. For a backend supporting looping--- it will most likely be @_1 . output@. This lens is required because the+-- uses for its diagram base case. If @MainOpts (QDiagram b v n Any) ~ DiagramOpts@+-- then this lens will simply be 'output'. This lens is required because the -- implementation works by modifying the output field and running the base @mainRender@. -- Typically a backend can write its @Animation B V@ instance as --@@ -563,86 +516,3 @@ where fmt = "%0" ++ show nDigits ++ "d" output' = addExtension (base ++ printf fmt i) ext (base, ext) = splitExtension (opts^.out)--putStrF :: String -> IO ()-putStrF s = putStr s >> hFlush stdout--defaultLoopRender :: DiagramLoopOpts -> IO ()-defaultLoopRender opts = when (opts ^. loop) $ do- putStrLn "Looping turned on"- prog <- getProgName- args <- getArgs-- srcPath <- case opts ^. src of- Just path -> return path- Nothing -> fromMaybe (error nosrc) <$> findHsFile prog- where- nosrc = "Unable to find Haskell source file.\n"- ++ "Specify source file with '-s' or '--src'"- srcPath' <- canonicalizePath srcPath-- sandbox <- findSandbox []- sandboxArgs <- case sandbox of- Nothing -> return []- Just sb -> do- putStrLn ("Using sandbox " ++ takeDirectory sb)- return ["-package-db", sb]-- let args' = delete "-l" . delete "--loop" $ args- newProg = newProgName (takeFileName srcPath) prog- timeOfDay = take 8 . drop 11 . show . eventTime-- withManagerConf defaultConfig $- \mgr -> do- lock <- newIORef False-- _ <- watchDir mgr (takeDirectory srcPath') (existsEvents (== srcPath'))- $ \ev -> do- running <- atomicModifyIORef lock ((,) True)- unless running $ do- putStrF ("Modified " ++ timeOfDay ev ++ " ... ")- exitCode <- recompile srcPath' newProg sandboxArgs- -- Call the new program without the looping option- run newProg args' exitCode- atomicWriteIORef lock False-- putStrLn $ "Watching source file " ++ srcPath- putStrLn $ "Compiling target: " ++ newProg- putStrLn $ "Program args: " ++ unwords args'- forever . threadDelay $ case os of- -- https://ghc.haskell.org/trac/ghc/ticket/7325- "darwin" -> 2000000000- _ -> maxBound--recompile :: FilePath -> FilePath -> [String] -> IO ExitCode-recompile srcFile outFile args = do- let ghcArgs = ["--make", srcFile, "-o", outFile] ++ args- putStrF "compiling ... "- (exit, _, stderr) <- readProcessWithExitCode "ghc" ghcArgs ""- when (exit /= ExitSuccess) $ putStrLn ('\n':stderr)- return exit---- | On Windows, the next compilation must have a different output--- than the currently running program.-newProgName :: FilePath -> String -> String-newProgName srcFile oldName = case os of- "mingw32" ->- if oldName == replaceExtension srcFile "exe"- then replaceExtension srcFile ".1.exe"- else replaceExtension srcFile "exe"- _ -> dropExtension srcFile---- | Run the given program with specified arguments, if and only if--- the previous command returned ExitSuccess.-run :: String -> [String] -> ExitCode -> IO ()-run prog args ExitSuccess = do- let path = "." </> prog- putStrF "running ... "- (exit, stdOut, stdErr) <- readProcessWithExitCode path args ""- case exit of- ExitSuccess -> putStrLn "done."- ExitFailure r -> do- putStrLn $ prog ++ " failed with exit code " ++ show r- unless (null stdOut) $ putStrLn "stdout:" >> putStrLn stdOut- unless (null stdErr) $ putStrLn "stderr:" >> putStrLn stdErr-run _ _ _ = return ()
src/Diagrams/Trail.hs view
@@ -539,6 +539,17 @@ _Snoc = _Wrapped . _Snoc . bimapping _Unwrapped id {-# INLINE _Snoc #-} +-- | Compose two Located trails by adding a segment joining the endpoint+-- of the first to the starting point of the second. Note, if you have+-- two located trails such that the end of the first coincides with the+-- start of the second, this will still add a trivial zero-length segment+-- between them; in that case you are probably better off with something+-- like @mapLoc (<> unLoc t2) t1@.+instance (Real n, Floating n, Metric v)+ => Semigroup (Located (Trail' Line v n)) where+ a@(Loc aLoc aLine) <> b@(Loc _ bLine) =+ Loc aLoc (aLine <> lineFromOffsets [atStart b .-. atEnd a] <> bLine)+ -------------------------------------------------- -- Extracting segments
src/Diagrams/TwoD/Segment.hs view
@@ -209,22 +209,32 @@ -> n -- ^ The upper bound of the interval -> [n] -- ^ The roots found bezierFindRoot eps p tmin tmax- | isNothing chopInterval = []- | clip > 0.8 = let (p1, p2) = splitAtParam newP 0.5- tmid = tmin' + (tmax' - tmin') / 2- in bezierFindRoot eps p1 tmin' tmid ++- bezierFindRoot eps p2 tmid tmax'- | tmax' - tmin' < eps = [avg tmin' tmax']- | otherwise = bezierFindRoot eps newP tmin' tmax'- where- chopInterval = chopYs (bernsteinCoeffs p)- Just (tminChop, tmaxChop) = chopInterval- newP = section p tminChop tmaxChop- clip = tmaxChop - tminChop- tmin' = tmax * tminChop + tmin * (1 - tminChop)- tmax' = tmax * tmaxChop + tmin * (1 - tmaxChop)--+ -- If we generated the max number of roots and tmax is also a root+ -- (which is not among the generated ones), there must in fact be an+ -- infinite number of roots, so just include tmax.+ | length roots == bernsteinDegree p && last roots /= tmax && abs (evaluateBernstein p tmax) <= eps+ = roots ++ [tmax]+ | otherwise = roots+ where+ -- Lazily take a number of roots at most the degree of the bernstein+ -- polynomial, to avoid generating a ton of roots in the case of a+ -- straight Bezier segment along the x-axis. See https://github.com/diagrams/diagrams-contrib/issues/91 .+ roots = take (bernsteinDegree p) $ go p tmin tmax+ go p tmin tmax+ | isNothing chopInterval = []+ | tmax' - tmin' < eps = [avg tmin' tmax']+ | clip > 0.8 = let (p1, p2) = splitAtParam newP 0.5+ tmid = tmin' + (tmax' - tmin') / 2+ in go p1 tmin' tmid +++ go p2 tmid tmax'+ | otherwise = bezierFindRoot eps newP tmin' tmax'+ where+ chopInterval = chopYs (bernsteinCoeffs p)+ Just (tminChop, tmaxChop) = chopInterval+ newP = section p tminChop tmaxChop+ clip = tmaxChop - tminChop+ tmin' = tmax * tminChop + tmin * (1 - tminChop)+ tmax' = tmax * tmaxChop + tmin * (1 - tmaxChop) ------------------------------------------------------------------------ -- Internal