Fix fragile docker builds. (#163)

Dockerfile.discord

@@ -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/

Dockerfile.playground

@@ -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/

src/Reanimate/Svg/LineCommand.hs

@@ -1,24 +1,25 @@
-{-|
+-- |
-Copyright   : Written by David Himmelstrup
+-- Copyright   : Written by David Himmelstrup
-License     : Unlicense
+-- License     : Unlicense
-Maintainer  : lemmih@gmail.com
+-- Maintainer  : lemmih@gmail.com
-Stability   : experimental
+-- Stability   : experimental
-Portability : POSIX
+-- Portability : POSIX
--}
 module Reanimate.Svg.LineCommand
-  ( CmdM
+  ( CmdM,
-  , LineCommand(..)
+    LineCommand (..),
-  , lineLength
+    lineLength,
-  , toLineCommands
+    toLineCommands,
-  , lineToPath
+    lineToPath,
-  , lineToPoints
+    lineToPoints,
-  , partialSvg
+    partialSvg,
-  ) where
+  )
+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
+  | -- | LineDraw RPoint
-  | LineBezier [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 <$>
+    EllipticalArc o points ->
-      forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
+      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 =
-        = tb - ta
+    tb - ta
-    | otherwise
+  | otherwise =
-        = pi * 2 - (ta - tb)
+    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
+  | x0 == x && y0 == y =
-        = []
+    []
-    | radiusX == 0.0 && radiusY == 0.0
+  | radiusX == 0.0 && radiusY == 0.0 =
-        = [LineBezier [V2 x y]]
+    [LineBezier [V2 x y]]
-    | otherwise
+  | otherwise =
-        = calcSegments x0 y0 theta1' segments'
+    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) *
+        else
-                        sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))
+          ( (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
+      | segments == 0 =
-                = []
+        []
-            | otherwise
+      | otherwise =
-                = LineBezier [ V2 (startX + dx1) (startY + dy1)
+        LineBezier
-                             , V2 (endpointX + dxe) (endpointY + dye)
+          [ V2 (startX + dx1) (startY + dy1),
-                             , V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)
+            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.
+-- | Create an image showing portion of a path.
-     Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
+--     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').
+--     You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
-
+--
-     Typical usage:
+--     Typical usage:
-
+--
-    > animate $ \t -> partialSvg t myPath
+--    > animate $ \t -> partialSvg t myPath
--}
+partialSvg ::
-partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
+  -- | 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
+  Double ->
-           -> Tree
+  -- | 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