Fix fragile docker builds. (#163)

This commit is contained in:
David Himmelstrup 2020-09-12 21:28:26 +08:00 committed by GitHub
commit 9ddfbde124
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 170 additions and 151 deletions

View file

@ -20,7 +20,10 @@ WORKDIR /src
# Install reanimate dependencies and cache the layer
ADD reanimate.cabal stack.yaml ./
RUN stack build --only-dependencies --no-install-ghc --system-ghc --haddock
RUN for i in 1 2 3; \
do \
stack build --only-dependencies --no-install-ghc --system-ghc --haddock && break; \
done
# Install discord-bot dependencies and cache the layer
ADD discord-bot/discord-bot.cabal discord-bot/stack.yaml ./discord-bot/

View file

@ -20,7 +20,10 @@ WORKDIR /src
# Install reanimate dependencies and cache the layer
ADD reanimate.cabal stack.yaml ./
RUN stack build --only-dependencies --no-install-ghc --system-ghc --haddock
RUN for i in 1 2 3; \
do \
stack build --only-dependencies --no-install-ghc --system-ghc --haddock && break; \
done
# Install discord-bot dependencies and cache the layer
ADD playground/playground.cabal playground/stack.yaml ./playground/

View file

@ -1,24 +1,25 @@
{-|
Copyright : Written by David Himmelstrup
License : Unlicense
Maintainer : lemmih@gmail.com
Stability : experimental
Portability : POSIX
-}
-- |
-- Copyright : Written by David Himmelstrup
-- License : Unlicense
-- Maintainer : lemmih@gmail.com
-- Stability : experimental
-- Portability : POSIX
module Reanimate.Svg.LineCommand
( CmdM
, LineCommand(..)
, lineLength
, toLineCommands
, lineToPath
, lineToPoints
, partialSvg
) where
( CmdM,
LineCommand (..),
lineLength,
toLineCommands,
lineToPath,
lineToPoints,
partialSvg,
)
where
import Control.Lens ((%~), (&), (.~))
import Control.Monad.Fix
import Control.Monad.State
import Data.Functor
import Data.Maybe
import qualified Data.Vector.Unboxed as V
import qualified Geom2D.CubicBezier.Linear as Bezier
import Graphics.SvgTree
@ -32,8 +33,8 @@ type CmdM a = State RPoint a
-- | Simplified version of a PathCommand where all points are absolute.
data LineCommand
= LineMove RPoint
-- | LineDraw RPoint
| LineBezier [RPoint]
| -- | LineDraw RPoint
LineBezier [RPoint]
| LineEnd RPoint
deriving (Show)
@ -52,12 +53,12 @@ lineToPath = map worker
-- | Using @n@ control points, approximate the path of the curves.
lineToPoints :: Int -> [LineCommand] -> [RPoint]
lineToPoints nPoints cmds =
map lineEnd lineSegments
mapMaybe lineEnd lineSegments
where
lineSegments = [partialLine (fromIntegral n / fromIntegral nPoints) cmds | n <- [0 .. nPoints -1]]
lineEnd [LineBezier pts] = last pts
lineEnd [] = Nothing
lineEnd [LineBezier pts] = Just (last pts)
lineEnd (_ : xs) = lineEnd xs
lineEnd _ = error "invalid line"
partialLine :: Double -> [LineCommand] -> [LineCommand]
partialLine alpha cmds = evalState (worker 0 cmds) zero
@ -165,10 +166,14 @@ toLineCommand startPos mbPrevControlPt cmd =
from <- get <* adjustPosition o to
let c1 = maybe from (mirrorPoint from) mbControl
pure $ LineBezier [c1, makeAbsolute o from to]
EllipticalArc o points -> concat <$>
forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
EllipticalArc o points ->
concat
<$> forM
points
( \(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
from <- get <* adjustPosition o to
return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))
return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to)
)
EndPath -> put startPos $> [LineEnd startPos]
where
mirrorPoint c p = c * 2 - p
@ -177,13 +182,12 @@ toLineCommand startPos mbPrevControlPt cmd =
makeAbsolute OriginAbsolute _from p = p
makeAbsolute OriginRelative from p = from + p
calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
calculateVectorAngle ux uy vx vy
| tb >= ta
= tb - ta
| otherwise
= pi * 2 - (ta - tb)
| tb >= ta =
tb - ta
| otherwise =
pi * 2 - (ta - tb)
where
ta = atan2 uy ux
tb = atan2 vy vx
@ -192,12 +196,12 @@ calculateVectorAngle ux uy vx vy
{- HLINT ignore convertSvgArc -}
convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
| x0 == x && y0 == y
= []
| radiusX == 0.0 && radiusY == 0.0
= [LineBezier [V2 x y]]
| otherwise
= calcSegments x0 y0 theta1' segments'
| x0 == x && y0 == y =
[]
| radiusX == 0.0 && radiusY == 0.0 =
[LineBezier [V2 x y]]
| otherwise =
calcSegments x0 y0 theta1' segments'
where
sinPhi = sin (angle * pi / 180)
cosPhi = cos (angle * pi / 180)
@ -210,10 +214,13 @@ convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
s = sqrt (1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))
rx = if (numerator < 0.0) then (radiusX * s) else radiusX
ry = if (numerator < 0.0) then (radiusY * s) else radiusY
root = if (numerator < 0.0)
root =
if (numerator < 0.0)
then (0.0)
else ((if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0) *
sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))
else
( (if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0)
* sqrt (numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash))
)
cxdash = root * rx * y1dash / ry
cydash = - root * ry * x1dash / rx
@ -223,7 +230,8 @@ convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)
dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((- x1dash - cxdash) / rx) ((- y1dash - cydash) / ry)
dtheta = if (not sweepFlag && dtheta' > 0)
dtheta =
if (not sweepFlag && dtheta' > 0)
then (dtheta' - 2 * pi)
else (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')
@ -232,12 +240,15 @@ convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
t = 8.0 / 3.0 * sin (delta / 4.0) * sin (delta / 4.0) / sin (delta / 2.0)
calcSegments startX startY theta1 segments
| segments == 0
= []
| otherwise
= LineBezier [ V2 (startX + dx1) (startY + dy1)
, V2 (endpointX + dxe) (endpointY + dye)
, V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)
| segments == 0 =
[]
| otherwise =
LineBezier
[ V2 (startX + dx1) (startY + dy1),
V2 (endpointX + dxe) (endpointY + dye),
V2 endpointX endpointY
] :
calcSegments endpointX endpointY theta2 (segments - 1)
where
cosTheta1 = cos theta1
sinTheta1 = sin theta1
@ -260,17 +271,19 @@ partialBezierPoints ps a b =
Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b
in V.toList os
{- | Create an image showing portion of a path.
Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
Typical usage:
> animate $ \t -> partialSvg t myPath
-}
partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
-> Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument
-> Tree
-- | Create an image showing portion of a path.
-- Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
-- You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
--
-- Typical usage:
--
-- > animate $ \t -> partialSvg t myPath
partialSvg ::
-- | number between 0 and 1 inclusively, determining what portion of the path to show
Double ->
-- | Image representing a path, of which we only want to display a portion determined by the first argument
Tree ->
Tree
partialSvg alpha | alpha >= 1 = id
partialSvg alpha = mapTree worker
where