diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,11 @@ +1.3.0.11 (6 June 2016) +---------------------- + +- allow `base-4.9` +- allow `data-default-0.7` +- allow `data-default-class-0.1` +- test with GHC 8.0.1 + 1.3.0.10 (1 May 2016) ----------------------- diff --git a/diagrams-contrib.cabal b/diagrams-contrib.cabal --- a/diagrams-contrib.cabal +++ b/diagrams-contrib.cabal @@ -1,5 +1,5 @@ name: diagrams-contrib -version: 1.3.0.10 +version: 1.3.0.11 synopsis: Collection of user contributions to diagrams EDSL description: A collection of user contributions for diagrams, an embedded domain-specific language for generation @@ -44,7 +44,7 @@ Diagrams.TwoD.Path.Metafont.Internal Diagrams.TwoD.Path.Metafont.Combinators Diagrams.TwoD.Path.Metafont.Parser - build-depends: base >= 4.2 && < 4.9, + build-depends: base >= 4.2 && < 4.10, mtl >= 2.0 && < 2.3, containers > 0.4 && < 0.6, split >= 0.2.1 && < 0.3, @@ -56,13 +56,13 @@ lens >= 4.0 && < 4.15, linear >= 1.11.3 && < 1.21, force-layout >= 0.4 && < 0.5, - data-default >= 0.5.2 && < 0.7, + data-default >= 0.5.2 && < 0.8, MonadRandom >= 0.1.8 && < 0.5, random >= 1.0 && < 1.2, circle-packing >= 0.1 && < 0.2, parsec >= 3.1 && < 3.2, text >= 0.11 && < 1.3, - data-default-class < 0.1, + data-default-class < 0.2, semigroups >= 0.3.4 && < 0.19 hs-source-dirs: src default-language: Haskell2010 @@ -82,7 +82,7 @@ test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2 && < 0.4, - base >= 4.2 && < 4.9, + base >= 4.2 && < 4.10, diagrams-lib >= 1.3 && < 1.4 default-language: Haskell2010 diff --git a/src/Diagrams/Layout/Wrap.hs b/src/Diagrams/Layout/Wrap.hs --- a/src/Diagrams/Layout/Wrap.hs +++ b/src/Diagrams/Layout/Wrap.hs @@ -16,7 +16,7 @@ module Diagrams.Layout.Wrap where import Control.Arrow (first, (&&&)) -import qualified Data.Foldable as F +import qualified Data.Foldable as F import Data.List (find, inits, tails) import Diagrams.Prelude hiding (start) import Linear.Epsilon @@ -29,14 +29,14 @@ -- | @wrapDiagram@ post-processes the results of @wrapOutside@ / -- @wrapInside@ into a Diagram of the result. This only works when -- applying them to a list of diagrams. -wrapDiagram :: (HasLinearMap v, Metric v, OrderedField n) +wrapDiagram :: (Metric v, OrderedField n) => ([(v n, QDiagram b v n Any)], [QDiagram b v n Any]) -> QDiagram b v n Any wrapDiagram = F.foldMap (uncurry translate) . fst -- | @wrapOutside@ is the same as @wrapInside@, but with an inverted -- predicate. wrapOutside :: ( Enveloped a, V a ~ v, N a ~ n - , Metric v, OrderedField n, Epsilon n -- See [6.12.3] note below + , Epsilon n -- See [6.12.3] note below ) => (Point v n -> Bool) -> [v n] -> Point v n -> [a] -> ([(v n, a)], [a]) wrapOutside f = wrapInside (not . f) diff --git a/src/Diagrams/TwoD/Grid.hs b/src/Diagrams/TwoD/Grid.hs --- a/src/Diagrams/TwoD/Grid.hs +++ b/src/Diagrams/TwoD/Grid.hs @@ -97,7 +97,6 @@ ) where import Diagrams.Prelude -import Diagrams.TwoD.Text import Data.List import Data.List.Split @@ -144,12 +143,12 @@ makeLenses ''HighlightLineOpts -- | Name a point by grid co-ordinates. -tick :: (Renderable (Text n) b, Renderable (Path V2 n) b, Floating n, Ord n) +tick :: (Floating n, Ord n) => (Int, Int) -> QDiagram b V2 n Any tick (n, m) = pointDiagram origin # named (n, m) -- | @gridWithHalves'@ with default opts. -gridWithHalves :: (Renderable (Text n) b, Renderable (Path V2 n) b, TypeableFloat n) +gridWithHalves :: (Renderable (Path V2 n) b, TypeableFloat n) => Int -> Int -> QDiagram b V2 n Any gridWithHalves = gridWithHalves' def @@ -157,7 +156,7 @@ -- points themselves or on points half way between grid points. The -- latter includes points a half grid length outside of the grid -- itself. -gridWithHalves' :: (Renderable (Text n) b, Renderable (Path V2 n) b, TypeableFloat n) +gridWithHalves' :: (Renderable (Path V2 n) b, TypeableFloat n) => GridOpts n -> Int -> Int -> QDiagram b V2 n Any gridWithHalves' opts n m = (mconcat lineXs # translate (r2 (llx, lly))) <> @@ -203,12 +202,11 @@ -- | Place a diagram on a grid (which is itself a diagram) at all the -- co-ordinates specified. -placeDiagramOnGrid :: (IsName nm, Renderable (Text n) b, - Renderable (Path V2 n) b, Floating n, Ord n) => +placeDiagramOnGrid :: (IsName nm, Floating n, Ord n) => QDiagram b V2 n Any -> [nm] -> QDiagram b V2 n Any -> QDiagram b V2 n Any placeDiagramOnGrid d = flip $ foldr (\n -> withName n (atop . place d . location)) -annotate :: (Renderable (Text n) b, Renderable (Path V2 n) b, Floating n, Ord n, Typeable n) => +annotate :: (Floating n, Ord n, Typeable n) => String -> (String -> QDiagram b V2 n Any) -> Colour Double -> @@ -222,13 +220,13 @@ addText s h = txtPt s # fc h -- | Draw a line between two named points on the grid. -gridLine :: (IsName a, IsName b, Renderable (Text n) c, +gridLine :: (IsName a, IsName b, Renderable (Path V2 n) c, TypeableFloat n) => a -> b -> QDiagram c V2 n Any -> QDiagram c V2 n Any gridLine = gridLine' def -- | Draw a line between two named points on the grid. -gridLine' :: (IsName a, IsName b, Renderable (Text n) c, +gridLine' :: (IsName a, IsName b, Renderable (Path V2 n) c, TypeableFloat n) => HighlightLineOpts n -> a -> b -> QDiagram c V2 n Any -> QDiagram c V2 n Any gridLine' opts u v = @@ -240,7 +238,7 @@ dashing (opts^.highLightLineDashingOnOff) (opts^.highLightLineDashingOffset)) -- | Draw lines between a list of pairs of named points on the grid. -gridLines :: (Renderable (Text n) c, Renderable (Path V2 n) c, TypeableFloat n, +gridLines :: (Renderable (Path V2 n) c, TypeableFloat n, IsName a, IsName b) => [(a, b)] -> QDiagram c V2 n Any -> QDiagram c V2 n Any gridLines xs = foldr (.) id [ gridLine x y | (x, y) <- xs ] diff --git a/src/Diagrams/TwoD/Layout/CirclePacking.hs b/src/Diagrams/TwoD/Layout/CirclePacking.hs --- a/src/Diagrams/TwoD/Layout/CirclePacking.hs +++ b/src/Diagrams/TwoD/Layout/CirclePacking.hs @@ -91,5 +91,5 @@ -- fits in the rectangular bounding box of the object, so it may be too small. -- It is, however, exact for circles, and there is no function that is safe for -- all diagrams and exact for circles. -circleRadius :: (Monoid' m, Floating (N b), Real (N b), Ord (N b)) => RadiusFunction b m +circleRadius :: (Monoid' m, Floating (N b), Real (N b)) => RadiusFunction b m circleRadius o = toFractional $ maximum [ envelopeS (e (alpha @@ turn)) o | alpha <- [0,0.25,0.5,0.75]] diff --git a/src/Diagrams/TwoD/Layout/Grid.hs b/src/Diagrams/TwoD/Layout/Grid.hs --- a/src/Diagrams/TwoD/Layout/Grid.hs +++ b/src/Diagrams/TwoD/Layout/Grid.hs @@ -45,7 +45,7 @@ -- <> gridCat - :: (Renderable (Path V2 n) b, TypeableFloat n) + :: TypeableFloat n => [QDiagram b V2 n Any] -> QDiagram b V2 n Any gridCat diagrams = gridCat' (intSqrt $ length diagrams) diagrams @@ -58,7 +58,7 @@ -- <> gridCat' - :: (Renderable (Path V2 n) b, TypeableFloat n) + :: TypeableFloat n => Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any gridCat' = gridAnimal id @@ -73,7 +73,7 @@ -- <> gridSnake - :: (Renderable (Path V2 n) b, TypeableFloat n) + :: TypeableFloat n => [QDiagram b V2 n Any] -> QDiagram b V2 n Any gridSnake diagrams = gridSnake' (intSqrt $ length diagrams) diagrams @@ -86,14 +86,14 @@ -- <> gridSnake' - :: (Renderable (Path V2 n) b, TypeableFloat n) + :: TypeableFloat n => Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any gridSnake' = gridAnimal (everyOther reverse) -- | Generalisation of gridCat and gridSnake to not repeat code. gridAnimal - :: (Renderable (Path V2 n) b, TypeableFloat n) + :: TypeableFloat n => ([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]]) -> Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any gridAnimal rowFunction cols = vcat . map hcat . rowFunction @@ -103,7 +103,7 @@ -- zero-indexed integer coordinates, to generate a grid of diagrams -- with the specified dimensions. gridWith - :: (Renderable (Path V2 n) b, TypeableFloat n) + :: TypeableFloat n => (Int -> Int -> QDiagram b V2 n Any) -> (Int, Int) -> QDiagram b V2 n Any gridWith f (cols, rows) = gridCat' cols diagrams @@ -115,7 +115,7 @@ -- | Make all diagrams have the same bounding square, -- one that bounds them all. sameBoundingSquare - :: forall b n. (Renderable (Path V2 n) b, TypeableFloat n) + :: forall b n. TypeableFloat n => [QDiagram b V2 n Any] -> [QDiagram b V2 n Any] sameBoundingSquare diagrams = map frameOne diagrams @@ -130,7 +130,7 @@ -- | Make all diagrams have the same bounding rect, -- one that bounds them all. sameBoundingRect - :: forall n b. (Renderable (Path V2 n) b, TypeableFloat n) + :: forall n b. TypeableFloat n => [QDiagram b V2 n Any] -> [QDiagram b V2 n Any] sameBoundingRect diagrams = map frameOne diagrams diff --git a/src/Diagrams/TwoD/Layout/Tree.hs b/src/Diagrams/TwoD/Layout/Tree.hs --- a/src/Diagrams/TwoD/Layout/Tree.hs +++ b/src/Diagrams/TwoD/Layout/Tree.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} @@ -131,19 +132,27 @@ import Physics.ForceLayout +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + import Control.Arrow (first, second, (&&&), (***)) import Control.Monad.State +import Control.Lens (makeLenses, (^.), (+=), (-=), view) import Data.Default import qualified Data.Foldable as F import Data.Function (on) import Data.List (mapAccumL) import qualified Data.Map as M import Data.Maybe +import Data.Semigroup import qualified Data.Traversable as T import Data.Tree +import Linear ((*^)) +import Linear.Affine ((.+^)) -import Diagrams.Prelude hiding (Empty) +import Diagrams ------------------------------------------------------------ -- Binary trees diff --git a/src/Diagrams/TwoD/Path/IteratedSubset.hs b/src/Diagrams/TwoD/Path/IteratedSubset.hs --- a/src/Diagrams/TwoD/Path/IteratedSubset.hs +++ b/src/Diagrams/TwoD/Path/IteratedSubset.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -176,7 +177,7 @@ -- | Seed for the Koch curve (side of the famous Koch 'snowflake'). -- -- <> -koch :: (TrailLike t, V t ~ V2, N t ~ n, Floating n) => t +koch :: (TrailLike t, V t ~ V2, N t ~ n) => t koch = fromOffsets [unitX, unitX # rotateBy (1/6), unitX # rotateBy (-1/6), unitX] -- > kochD = showTrail 4 koch @@ -252,11 +253,17 @@ -- | Generate a random 'IterTrailConfig'. This features many -- hard-coded values. If you want to play with it just copy the -- code and modify it to suit. -randITC :: (MonadRandom m, Applicative m, Ord n, Floating n, Random n) => +randITC :: + (MonadRandom m, +#if MIN_VERSION_base(4,9,0) +#else + Applicative m, +#endif + Ord n, Floating n, Random n) => m (IterTrailConfig n) randITC = do -- use between two and five segments for the seed pattern - nSegs <- getRandomR (2,5) + nSegs <- getRandomR (2,5) -- should we make the seed pattern a cubic spline? spline <- getRandom diff --git a/src/Diagrams/TwoD/Path/Metafont/Internal.hs b/src/Diagrams/TwoD/Path/Metafont/Internal.hs --- a/src/Diagrams/TwoD/Path/Metafont/Internal.hs +++ b/src/Diagrams/TwoD/Path/Metafont/Internal.hs @@ -59,7 +59,7 @@ rightCurl _ = False -- | Normalize a number representing number of turns to ±½ -normalizeTurns :: (Ord n, RealFrac n) => n -> n +normalizeTurns :: RealFrac n => n -> n normalizeTurns t | t > 1/2 = t - realToFrac (ceiling t :: Int) normalizeTurns t | t < -1/2 = t - realToFrac (floor t :: Int) normalizeTurns t = t @@ -135,14 +135,14 @@ controlPtDirs :: forall n. (Num n, Eq n) => MFS n -> MFS n controlPtDirs s@(MFS z0 (PJ _ jj@(Right (CJ u v)) _) z1) = s & pj .~ dirs where dirs = PJ (dir z0 u) jj (dir v z1) - dir :: Num n => P2 n -> P2 n -> Maybe (PathDir n) + dir :: P2 n -> P2 n -> Maybe (PathDir n) dir p0 p1 | p0 == p1 = Just $ PathDirCurl 1 dir p0 p1 | otherwise = Just . PathDirDir . direction $ (p1 .-. p0) controlPtDirs s = s -- | Run all the rules required to fully specify all segment directions, -- but do not replace the Joins with ControlJoin. -solve :: (RealFloat n, Eq n) => MFP n -> MFPath (Dir n) (BasicJoin n) n +solve :: RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n solve = solvePath . fillDirs -- | each sublist of groupSegments ss satisfies: @@ -334,7 +334,7 @@ -- recovered by subtracting the control points from the endpoints -- anyway). computeControls - :: (RealFloat n, Ord n) => MetafontSegment (Dir n) (BasicJoin n) n + :: RealFloat n => MetafontSegment (Dir n) (BasicJoin n) n -> MetafontSegment () (ControlJoin n) n computeControls (MFS z0 (PJ _ (Right cj) _) z1) = MFS z0 (PJ () cj ()) z1 @@ -374,7 +374,7 @@ -- @z0 .. controls u and v .. z1@. -- -- This uses a mysterious, magical formula due to John Hobby. -ctrlPts :: (RealFloat n, Eq n) => P2 n -> V2 n -> n -> n -> V2 n -> P2 n -> (P2 n, P2 n) +ctrlPts :: RealFloat n => P2 n -> V2 n -> n -> n -> V2 n -> P2 n -> (P2 n, P2 n) ctrlPts z0 w0 va vb w1 z1 = (u,v) where offs = z1 .-. z0 diff --git a/src/Diagrams/TwoD/Path/Metafont/Parser.hs b/src/Diagrams/TwoD/Path/Metafont/Parser.hs --- a/src/Diagrams/TwoD/Path/Metafont/Parser.hs +++ b/src/Diagrams/TwoD/Path/Metafont/Parser.hs @@ -11,7 +11,7 @@ import Diagrams.Prelude hiding (option) import Diagrams.TwoD.Path.Metafont.Types -num :: (Num n, Read n) => Parser n +num :: Read n => Parser n num = read <$> float where sign = plus <|> minus <|> unsigned plus = char '+' *> unsigned @@ -22,7 +22,7 @@ -- points -xy :: (Num n, Read n) => Parser (n, n) +xy :: Read n => Parser (n, n) xy = do spaces x <- num @@ -31,7 +31,7 @@ spaces return (x,y) -pt :: (Num n, Read n) => Parser (P2 n) +pt :: Read n => Parser (P2 n) pt = char '(' *> (p2 <$> xy) <* char ')' -- Joins @@ -47,11 +47,11 @@ dotsJoin = string ".." *> spaces *> (boundedJoin <|>tensionJoin <|> controlJoin <|> plainJoin) -plainJoin :: (Num n, Read n) => Parser (BasicJoin n) +plainJoin :: Num n => Parser (BasicJoin n) plainJoin = pure (Left $ TJ t1' t1') where t1' = TensionAmt 1 -tensionJoin :: (Num n, Read n) => Parser (BasicJoin n) +tensionJoin :: Read n => Parser (BasicJoin n) tensionJoin = do string "tension" spaces @@ -60,7 +60,7 @@ string ".." return . Left $ TJ (TensionAmt t1') (TensionAmt t2') -controlJoin :: (Num n, Read n) => Parser (BasicJoin n) +controlJoin :: Read n => Parser (BasicJoin n) controlJoin = do string "controls" *> spaces z1 <- pt @@ -69,28 +69,28 @@ spaces *> string ".." return . Right $ CJ z1 z2 -boundedJoin :: (Num n, Read n) => Parser (BasicJoin n) +boundedJoin :: Num n => Parser (BasicJoin n) boundedJoin = char '.' *> pure (Left $ TJ t t) where t = TensionAtLeast 1 -straightJoin :: (Num n, Read n) => Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n)) +straightJoin :: Num n => Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n)) straightJoin = try (string "--" *> notFollowedBy (char '-')) *> pure (PJ c jj c) where c = Just $ PathDirCurl 1 jj = Left $ TJ (TensionAmt 1) (TensionAmt 1) -tenseLine :: (Num n, Read n) => Parser (BasicJoin n) +tenseLine :: Num n => Parser (BasicJoin n) -- 4096 is the constant 'infinity' in Plain MetaFont tenseLine = string "---" *> pure (Left $ TJ t t) where t = TensionAmt 4096 -- Directions -dir :: (Num n, Read n) => Parser (PathDir n) +dir :: Read n => Parser (PathDir n) dir = PathDirDir . direction . r2 <$> xy -curl :: (Num n, Read n) => Parser (PathDir n) +curl :: Read n => Parser (PathDir n) curl = PathDirCurl <$> (string "curl" *> spaces *> num) -pathDir :: (Num n, Read n) => Parser (PathDir n) +pathDir :: Read n => Parser (PathDir n) pathDir = do char '{' *> spaces d <- curl <|> dir diff --git a/src/Diagrams/TwoD/Path/Turtle.hs b/src/Diagrams/TwoD/Path/Turtle.hs --- a/src/Diagrams/TwoD/Path/Turtle.hs +++ b/src/Diagrams/TwoD/Path/Turtle.hs @@ -31,6 +31,7 @@ ) where import qualified Control.Lens as L +import Control.Monad (liftM) import qualified Control.Monad.State as ST import Diagrams.Prelude @@ -52,9 +53,9 @@ -- | A more general way to run the turtle. Returns a computation in -- the underlying monad @m@ yielding the final diagram. -drawTurtleT :: (Monad m, Functor m, Renderable (Path V2 n) b, TypeableFloat n) +drawTurtleT :: (Monad m, Renderable (Path V2 n) b, TypeableFloat n) => TurtleT n m a -> m (QDiagram b V2 n Any) -drawTurtleT = fmap T.getTurtleDiagram . runTurtleT +drawTurtleT = liftM T.getTurtleDiagram . runTurtleT -- | Run the turtle, yielding a diagram. drawTurtle :: (Renderable (Path V2 n) b, TypeableFloat n) => @@ -64,8 +65,8 @@ -- | A more general way to run the turtle. Returns a computation in -- the underlying monad @m@, ignoring any pen style commands and -- yielding a 2D path. -sketchTurtleT :: (Functor m, Monad m, Floating n, Ord n) => TurtleT n m a -> m (Path V2 n) -sketchTurtleT = fmap T.getTurtlePath . runTurtleT +sketchTurtleT :: (Monad m, Floating n, Ord n) => TurtleT n m a -> m (Path V2 n) +sketchTurtleT = liftM T.getTurtlePath . runTurtleT -- | Run the turtle, ignoring any pen style commands and yielding a -- 2D path. @@ -101,7 +102,7 @@ heading = ST.gets (L.view deg . T.heading) -- | Sets the heading towards a given location. -towards :: (Monad m, RealFloat n, Ord n) => P2 n -> TurtleT n m () +towards :: (Monad m, RealFloat n) => P2 n -> TurtleT n m () towards pt = ST.modify $ T.towards pt -- | Set the current turtle X/Y position. diff --git a/src/Diagrams/TwoD/Path/Turtle/Internal.hs b/src/Diagrams/TwoD/Path/Turtle/Internal.hs --- a/src/Diagrams/TwoD/Path/Turtle/Internal.hs +++ b/src/Diagrams/TwoD/Path/Turtle/Internal.hs @@ -131,26 +131,28 @@ -- | Turn the turtle by applying the given function to its current orientation -- (in degrees) -turnTurtle :: (Floating n, Ord n) => - (Angle n -> Angle n) -- ^ Transformation to apply on current orientation +turnTurtle :: (Angle n -> Angle n) -- ^ Transformation to apply on current orientation -> TurtleState n -- ^ Turtle to turn -> TurtleState n -- ^ Resulting turtle turnTurtle f t@(TurtleState _ _ h _ _ _) = t { heading = f h } -- | Turn the turtle anti-clockwise (left) -left :: (Floating n, Ord n) => n -- ^ Degree of turn +left :: Floating n + => n -- ^ Degree of turn -> TurtleState n -- ^ Turtle to turn -> TurtleState n -- ^ Resulting turtle left d = turnTurtle (^+^ (d @@ deg)) -- | Turn the turtle clockwise (right) -right :: (Floating n, Ord n) => n -- ^ Degree of turn +right :: Floating n + => n -- ^ Degree of turn -> TurtleState n -- ^ Turtle to turn -> TurtleState n -- ^ Resulting turtle right d = turnTurtle (^-^ (d @@ deg)) -- | Turn the turtle to the given orientation, in degrees -setHeading :: (Floating n, Ord n) => n -- ^ Degree of orientation +setHeading :: Floating n + => n -- ^ Degree of orientation -> TurtleState n -- ^ Turtle to orient -> TurtleState n -- ^ Resulting turtle setHeading d = turnTurtle (const $ d @@ deg)