diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## [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` diff --git a/diagrams-lib.cabal b/diagrams-lib.cabal --- a/diagrams-lib.cabal +++ b/diagrams-lib.cabal @@ -1,5 +1,5 @@ Name: diagrams-lib -Version: 1.4.7 +Version: 1.5 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,7 +101,7 @@ 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, @@ -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, diff --git a/src/Diagrams/Backend/CmdLine.hs b/src/Diagrams/Backend/CmdLine.hs --- a/src/Diagrams/Backend/CmdLine.hs +++ b/src/Diagrams/Backend/CmdLine.hs @@ -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 ()