diff --git a/.github/workflows/ormolu.yaml b/.github/workflows/ormolu.yaml new file mode 100644 index 0000000..f5f1421 --- /dev/null +++ b/.github/workflows/ormolu.yaml @@ -0,0 +1,51 @@ +# FUTUREWORK: add this to `ci.dhall`? + +name: Ormolu +on: + - pull_request + +jobs: + ormolu: + runs-on: ubuntu-18.04 + steps: + - uses: "actions/checkout@v1" + + - uses: "actions/setup-haskell@v1.1.4" + id: setup-haskell-cabal + with: + cabal-version: "${{ matrix.cabal }}" + enable-stack: false + ghc-version: "${{ matrix.ghc }}" + + - uses: "actions/cache@v2" + name: Cache + with: + key: "${{ runner.os }}" + path: | + "${{ steps.setup-haskell-cabal.outputs.cabal-store }}" + ~/.cabal/packages + ~/.cabal/store + ~/.cabal/bin + dist-newstyle + ~/.local/bin + + - name: Install dependencies + run: | + export PATH=$PATH:$HOME/.cabal/bin:$HOME/.local/bin + export ORMOLU_VERSION=$(cat ./layout/ormolu.version) + (ormolu -v 2>/dev/null | grep -q $ORMOLU_VERSION) || (cabal update && cabal install ormolu --constraint="ormolu ==$ORMOLU_VERSION") + test -e $HOME/.local/bin/yq || pip3 install yq + shell: bash + + - name: Ormolu + run: | + export PATH=$PATH:$HOME/.cabal/bin:$HOME/.local/bin + ./layout/ormolu.sh -c + shell: bash + + strategy: + matrix: + cabal: + - '3.2' + ghc: + - '8.10.1' diff --git a/Examples/example11.hs b/Examples/example11.hs index 9ef62ca..643721e 100644 --- a/Examples/example11.hs +++ b/Examples/example11.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Example 11 - the union of a square and a circle. import Graphics.Implicit diff --git a/Examples/example12.hs b/Examples/example12.hs index e97b272..ab1f0a8 100644 --- a/Examples/example12.hs +++ b/Examples/example12.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Example 12 - the rounded union of a square and a circle. import Control.Applicative (pure) import Graphics.Implicit diff --git a/Examples/example13.hs b/Examples/example13.hs index b48ce85..518c465 100644 --- a/Examples/example13.hs +++ b/Examples/example13.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Example 13 - the rounded union of a cube and a sphere. import Control.Applicative (pure) import Graphics.Implicit diff --git a/Examples/example16.hs b/Examples/example16.hs index 425d141..2e75bc4 100644 --- a/Examples/example16.hs +++ b/Examples/example16.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} import Control.Applicative (pure) import Graphics.Implicit import Graphics.Implicit.Definitions diff --git a/Examples/example17.hs b/Examples/example17.hs index 5517550..3d09c99 100644 --- a/Examples/example17.hs +++ b/Examples/example17.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Example 17, pulled from our benchmarking suite. import Control.Applicative (pure) import Prelude ((<$>), ($), zipWith3, fmap, fromIntegral, (*), (/), Bool(..)) diff --git a/Graphics/Implicit.hs b/Graphics/Implicit.hs index 04ff94d..b08ab06 100644 --- a/Graphics/Implicit.hs +++ b/Graphics/Implicit.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -195,7 +196,6 @@ writePNG2 -> IO () writePNG2 = Export.writePNG - -- | Export a PNG of the 'SymbolicObj3'. The projection is with a front-facing -- camera, so the coordinate system is @(left to right, front to back, down to -- up)@. diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs index f0a948d..242a352 100644 --- a/Graphics/Implicit/Definitions.hs +++ b/Graphics/Implicit/Definitions.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, 2017, 2018, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) @@ -247,7 +248,6 @@ instance (Show obj, Show vec) => Show (SharedObj obj vec) where EmbedBoxedObj _ -> showCon "implicit" @| Blackhole WithRounding r obj -> showCon "withRounding" @| r @| obj - ------------------------------------------------------------------------------ -- | A type whose show instance is a hole @_@. Used for giving 'Show' instances -- to data types which contain functions or other unshowable things. @@ -256,7 +256,6 @@ data Blackhole = Blackhole instance Show Blackhole where show _ = "_" - newtype ObjectContext = ObjectContext { objectRounding :: ℝ } deriving (Eq, Ord, Show) @@ -266,7 +265,6 @@ defaultObjectContext = ObjectContext { objectRounding = 0 } - -- | A symbolic 2D object format. -- We want to have symbolic objects so that we can -- accelerate rendering & give ideal meshes for simple @@ -293,13 +291,10 @@ instance Show SymbolicObj2 where Rotate2 v obj -> showCon "rotate" @| v @| obj Shared2 obj -> flip showsPrec obj - - -- | Semigroup under 'Graphic.Implicit.Primitives.union'. instance Semigroup SymbolicObj2 where a <> b = Shared2 (UnionR 0 [a, b]) - -- | Monoid under 'Graphic.Implicit.Primitives.union'. instance Monoid SymbolicObj2 where mempty = Shared2 Empty @@ -352,7 +347,6 @@ instance Show SymbolicObj3 where showCon "extrudeOnEdgeOf" @| s @| s1 Shared3 s -> flip showsPrec s - infixl 2 @|| ------------------------------------------------------------------------------ -- | ImplicitCAD uses the pattern @Either a (b -> c)@ for many of its @@ -365,7 +359,6 @@ showF @|| x = showApp showF $ case x of Left a -> showCon "Left" @| a Right _ -> showCon "Right" @| Blackhole - -- | Semigroup under 'Graphic.Implicit.Primitives.union'. instance Semigroup SymbolicObj3 where a <> b = Shared3 (UnionR 0 [a, b]) diff --git a/Graphics/Implicit/Export.hs b/Graphics/Implicit/Export.hs index bad5b62..16bb1a9 100644 --- a/Graphics/Implicit/Export.hs +++ b/Graphics/Implicit/Export.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2015 2016, Mike MacHenry (mike.machenry@gmail.com) diff --git a/Graphics/Implicit/Export/DiscreteAproxable.hs b/Graphics/Implicit/Export/DiscreteAproxable.hs index 4a585b6..4e72371 100644 --- a/Graphics/Implicit/Export/DiscreteAproxable.hs +++ b/Graphics/Implicit/Export/DiscreteAproxable.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/NormedTriangleMeshFormats.hs b/Graphics/Implicit/Export/NormedTriangleMeshFormats.hs index aa6cef9..b78b547 100644 --- a/Graphics/Implicit/Export/NormedTriangleMeshFormats.hs +++ b/Graphics/Implicit/Export/NormedTriangleMeshFormats.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016 Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/PolylineFormats.hs b/Graphics/Implicit/Export/PolylineFormats.hs index 93c9b87..bad9d6b 100644 --- a/Graphics/Implicit/Export/PolylineFormats.hs +++ b/Graphics/Implicit/Export/PolylineFormats.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/RayTrace.hs b/Graphics/Implicit/Export/RayTrace.hs index 284bc58..95abfda 100644 --- a/Graphics/Implicit/Export/RayTrace.hs +++ b/Graphics/Implicit/Export/RayTrace.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -172,4 +173,3 @@ traceRay ray@(Ray cameraP cameraV) step box (Scene obj objColor lights defaultCo ) Nothing -> defaultColor - diff --git a/Graphics/Implicit/Export/Render.hs b/Graphics/Implicit/Export/Render.hs index 268bb64..c0d124e 100644 --- a/Graphics/Implicit/Export/Render.hs +++ b/Graphics/Implicit/Export/Render.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/Definitions.hs b/Graphics/Implicit/Export/Render/Definitions.hs index 3013fed..9454c3a 100644 --- a/Graphics/Implicit/Export/Render/Definitions.hs +++ b/Graphics/Implicit/Export/Render/Definitions.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/GetLoops.hs b/Graphics/Implicit/Export/Render/GetLoops.hs index 3b391e3..5dc9209 100644 --- a/Graphics/Implicit/Export/Render/GetLoops.hs +++ b/Graphics/Implicit/Export/Render/GetLoops.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/GetSegs.hs b/Graphics/Implicit/Export/Render/GetSegs.hs index 86be245..fec9c59 100644 --- a/Graphics/Implicit/Export/Render/GetSegs.hs +++ b/Graphics/Implicit/Export/Render/GetSegs.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -30,7 +31,6 @@ import Linear (V2(V2)) To allow data sharing, lots of values we could calculate are instead arguments. - positions obj values --------- ---------- @@ -38,7 +38,6 @@ import Linear (V2(V2)) : : => : : (x1,y1) .. (x2,y1) x1y1 .. x2y2 - mid points ---------- diff --git a/Graphics/Implicit/Export/Render/HandlePolylines.hs b/Graphics/Implicit/Export/Render/HandlePolylines.hs index 441d26e..21a7300 100644 --- a/Graphics/Implicit/Export/Render/HandlePolylines.hs +++ b/Graphics/Implicit/Export/Render/HandlePolylines.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2012, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/HandleSquares.hs b/Graphics/Implicit/Export/Render/HandleSquares.hs index 5f2e1d5..7e6a348 100644 --- a/Graphics/Implicit/Export/Render/HandleSquares.hs +++ b/Graphics/Implicit/Export/Render/HandleSquares.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/Interpolate.hs b/Graphics/Implicit/Export/Render/Interpolate.hs index 00d9fbc..320700d 100644 --- a/Graphics/Implicit/Export/Render/Interpolate.hs +++ b/Graphics/Implicit/Export/Render/Interpolate.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/RefineSegs.hs b/Graphics/Implicit/Export/Render/RefineSegs.hs index c6e0765..dde3bd8 100644 --- a/Graphics/Implicit/Export/Render/RefineSegs.hs +++ b/Graphics/Implicit/Export/Render/RefineSegs.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Render/TesselateLoops.hs b/Graphics/Implicit/Export/Render/TesselateLoops.hs index a8b99cf..3d70691 100644 --- a/Graphics/Implicit/Export/Render/TesselateLoops.hs +++ b/Graphics/Implicit/Export/Render/TesselateLoops.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -23,7 +24,6 @@ tesselateLoop _ _ [] = [] tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [Tris $ TriangleMesh [Triangle (a,b,c)]] - {- #____# #____# | | | | @@ -92,7 +92,6 @@ tesselateLoop res obj pathSides = pure $ Tris $ TriangleMesh $ then early_tris <> [Triangle (a,b,mid') | (a,b) <- zip path (tail path <> [head path]) ] else early_tris <> [Triangle (a,b,mid) | (a,b) <- zip path (tail path <> [head path]) ] - shrinkLoop :: ℕ -> [ℝ3] -> ℝ -> Obj3 -> ([Triangle], [ℝ3]) shrinkLoop _ path@[a,b,c] res obj = diff --git a/Graphics/Implicit/Export/Symbolic/Rebound2.hs b/Graphics/Implicit/Export/Symbolic/Rebound2.hs index 404fc0d..5d6fc1a 100644 --- a/Graphics/Implicit/Export/Symbolic/Rebound2.hs +++ b/Graphics/Implicit/Export/Symbolic/Rebound2.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016 Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Symbolic/Rebound3.hs b/Graphics/Implicit/Export/Symbolic/Rebound3.hs index 99620f2..0fad2ae 100644 --- a/Graphics/Implicit/Export/Symbolic/Rebound3.hs +++ b/Graphics/Implicit/Export/Symbolic/Rebound3.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016 Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs index 496517d..49b6089 100644 --- a/Graphics/Implicit/Export/SymbolicFormats.hs +++ b/Graphics/Implicit/Export/SymbolicFormats.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016 Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -54,7 +55,6 @@ call = callToken ("[", "]") callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder callNaked = callToken ("", "") - ------------------------------------------------------------------------------ -- | Class which allows us to build the contained objects in 'buildShared'. class Build obj where @@ -66,7 +66,6 @@ instance Build SymbolicObj2 where instance Build SymbolicObj3 where build = buildS3 - ------------------------------------------------------------------------------ -- | Unpack a dimensionality-polymorphic vector into multiple arguments. vectAsArgs :: VectorStuff vec => vec -> [Builder] @@ -77,7 +76,6 @@ vectAsArgs = fmap bf . elements bvect :: VectorStuff vec => vec -> Builder bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]" - ------------------------------------------------------------------------------ -- | Build the common combinators. buildShared :: forall obj vec. (Build obj, VectorStuff vec) => SharedObj obj vec -> Reader ℝ Builder @@ -120,7 +118,6 @@ buildShared(Shell _ _) = error "cannot provide roundness when exporting openscad buildShared(EmbedBoxedObj _) = error "cannot provide roundness when exporting openscad; unsupported in target format." buildShared (WithRounding _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format." - -- | First, the 3D objects. buildS3 :: SymbolicObj3 -> Reader ℝ Builder @@ -143,7 +140,6 @@ buildS3 (Rotate3 q obj) = buildS3 (Extrude obj h) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj] - -- FIXME: handle scale, center. buildS3 (ExtrudeM twist scale (Left translate) obj (Left height)) |isScaleID scale && translate == V2 0 0 = do res <- ask diff --git a/Graphics/Implicit/Export/SymbolicObj2.hs b/Graphics/Implicit/Export/SymbolicObj2.hs index 1ae07da..169fb72 100644 --- a/Graphics/Implicit/Export/SymbolicObj2.hs +++ b/Graphics/Implicit/Export/SymbolicObj2.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/SymbolicObj3.hs b/Graphics/Implicit/Export/SymbolicObj3.hs index f9d3935..d41a082 100644 --- a/Graphics/Implicit/Export/SymbolicObj3.hs +++ b/Graphics/Implicit/Export/SymbolicObj3.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/TextBuilderUtils.hs b/Graphics/Implicit/Export/TextBuilderUtils.hs index 3a34d8e..6136260 100644 --- a/Graphics/Implicit/Export/TextBuilderUtils.hs +++ b/Graphics/Implicit/Export/TextBuilderUtils.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/TriangleMeshFormats.hs b/Graphics/Implicit/Export/TriangleMeshFormats.hs index f9f4c21..e6936a0 100644 --- a/Graphics/Implicit/Export/TriangleMeshFormats.hs +++ b/Graphics/Implicit/Export/TriangleMeshFormats.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014, 2015, 2016 Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/Export/Util.hs b/Graphics/Implicit/Export/Util.hs index 2444ad4..ac6c697 100644 --- a/Graphics/Implicit/Export/Util.hs +++ b/Graphics/Implicit/Export/Util.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad.hs b/Graphics/Implicit/ExtOpenScad.hs index 97b884a..5884b4d 100644 --- a/Graphics/Implicit/ExtOpenScad.hs +++ b/Graphics/Implicit/ExtOpenScad.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Default.hs b/Graphics/Implicit/ExtOpenScad/Default.hs index f58943d..ad7b66b 100644 --- a/Graphics/Implicit/ExtOpenScad/Default.hs +++ b/Graphics/Implicit/ExtOpenScad/Default.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index b70c4ab..9a97210 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Constant.hs b/Graphics/Implicit/ExtOpenScad/Eval/Constant.hs index 83e6f17..fa81f69 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Constant.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Constant.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs b/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs index 951f6c6..4d2f4f4 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs index f00c207..dd14607 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Expr.hs b/Graphics/Implicit/ExtOpenScad/Parser/Expr.hs index 6adc73c..1ebff4b 100644 --- a/Graphics/Implicit/ExtOpenScad/Parser/Expr.hs +++ b/Graphics/Implicit/ExtOpenScad/Parser/Expr.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014-2019 , Julia Longtin (julial@turinglace.com) -- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com) diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Lexer.hs b/Graphics/Implicit/ExtOpenScad/Parser/Lexer.hs index cb67745..224ff35 100644 --- a/Graphics/Implicit/ExtOpenScad/Parser/Lexer.hs +++ b/Graphics/Implicit/ExtOpenScad/Parser/Lexer.hs @@ -1,9 +1,9 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE - -- Allow us to use string literals for Text {-# LANGUAGE OverloadedStrings #-} @@ -139,7 +139,6 @@ matchCAT = P.reservedOp lexer "++" >> pure "++" matchEXP :: GenParser Char st Char matchEXP = P.reservedOp lexer "^" >> pure '^' - -- | match something between two ends. surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a surroundedBy leftTok middle rightTok = between (matchTok leftTok) (matchTok rightTok) middle diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs b/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs index b9f1f05..e3e5f73 100644 --- a/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs +++ b/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -48,7 +49,6 @@ parseProgram = parse program where program :: GenParser Char st [StatementI] program = removeNoOps <$> (whiteSpace *> many (computation A1) <* eof) - -- | A computable block of code in our openscad-like programming language. computation :: CompIdx -> GenParser Char st StatementI computation A1 = diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Util.hs b/Graphics/Implicit/ExtOpenScad/Parser/Util.hs index cc09a4e..c0711b3 100644 --- a/Graphics/Implicit/ExtOpenScad/Parser/Util.hs +++ b/Graphics/Implicit/ExtOpenScad/Parser/Util.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016 Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index 36c4355..cb9112e 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -227,7 +228,6 @@ cylinder = moduleWithoutSuite "cylinder" $ \_ _ -> do `doc` "top diameter; overrides d" pure (diameter/2, diameter1/2, diameter2/2) - h :: Either ℝ ℝ2 <- argument "h" `defaultTo` Left 1 `doc` "height of cylinder" @@ -485,7 +485,6 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \_ children -> do . rotateExtrudeDegrees totalRot translateArg rotateArg ) children - -- | Like 'Prim.rotateExtrude', but operates in degrees instead of radians. -- This is a shim for scad, which expects this function to operate in degrees. rotateExtrudeDegrees diff --git a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs index 6d0f0c2..05a40b8 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs index 992bb80..3c15473 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs index f62ea71..58f5e8f 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/FastIntUtil.hs b/Graphics/Implicit/FastIntUtil.hs index 8e592bd..c6548d3 100644 --- a/Graphics/Implicit/FastIntUtil.hs +++ b/Graphics/Implicit/FastIntUtil.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014-2019, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/IntegralUtil.hs b/Graphics/Implicit/IntegralUtil.hs index c859794..f90eef0 100644 --- a/Graphics/Implicit/IntegralUtil.hs +++ b/Graphics/Implicit/IntegralUtil.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014-2019, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/MathUtil.hs b/Graphics/Implicit/MathUtil.hs index 6a32130..3e51fcb 100644 --- a/Graphics/Implicit/MathUtil.hs +++ b/Graphics/Implicit/MathUtil.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -133,7 +134,6 @@ pack (dx, dy) sep objs = packSome sortedObjs (dx, dy) tmap2 (presObj:) $ packSome otherBoxedObjs box packSome [] _ = ([], []) - -- | Reflect a vector across a hyperplane defined by its normal vector. -- -- From https://en.wikipedia.org/wiki/Reflection_(mathematics)#Reflection_through_a_hyperplane_in_n_dimensions diff --git a/Graphics/Implicit/ObjectUtil.hs b/Graphics/Implicit/ObjectUtil.hs index ea2fdcb..326373e 100644 --- a/Graphics/Implicit/ObjectUtil.hs +++ b/Graphics/Implicit/ObjectUtil.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/Graphics/Implicit/ObjectUtil/GetBox2.hs b/Graphics/Implicit/ObjectUtil/GetBox2.hs index 5c10380..c4ffa92 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox2.hs +++ b/Graphics/Implicit/ObjectUtil/GetBox2.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -21,7 +22,6 @@ import Graphics.Implicit.ObjectUtil.GetBoxShared (emptyBox, corners, outsetBox, -- To construct vectors of ℝs. import Linear (V2(V2)) - -- Get a Box2 around the given object. getBox2 :: SymbolicObj2 -> Box2 -- Primitives @@ -35,7 +35,6 @@ getBox2 (Rotate2 θ symbObj) = in pointsBox $ fmap rotate $ corners $ getBox2 symbObj getBox2 (Shared2 obj) = getBoxShared obj - -- | Define a Box2 around the given object, and the space it occupies while rotating about the center point. -- Note: No implementations for Square, Translate2, or Scale2 as they would be identical to the fallthrough. getBox2R :: SymbolicObj2 -> ℝ -> Box2 diff --git a/Graphics/Implicit/ObjectUtil/GetBox3.hs b/Graphics/Implicit/ObjectUtil/GetBox3.hs index e827d59..14392fa 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox3.hs +++ b/Graphics/Implicit/ObjectUtil/GetBox3.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) @@ -145,7 +146,6 @@ getBox3 (RotateExtrude rot (Right f) rotate symbObj) = in (V3 (-r) (-r) $ y1 + ymin', V3 r r $ y2 + ymax') - unpack :: V2 a -> (a, a) unpack (V2 a b) = (a, b) diff --git a/Graphics/Implicit/ObjectUtil/GetBoxShared.hs b/Graphics/Implicit/ObjectUtil/GetBoxShared.hs index 99e6e9e..8111f72 100644 --- a/Graphics/Implicit/ObjectUtil/GetBoxShared.hs +++ b/Graphics/Implicit/ObjectUtil/GetBoxShared.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) @@ -19,7 +20,6 @@ import Linear (Metric, V2(V2), V3(V3)) import Data.Foldable (Foldable(toList)) import Control.Applicative (Applicative(liftA2)) - ------------------------------------------------------------------------------ -- | Ad-hoc methods we need to share code between 2D and 3D. With the exception -- of 'corners', these are actually all standard methods of other classes, @@ -37,7 +37,6 @@ class VectorStuff vec where -- | Given a bounding box, produce the points at each corner. corners :: (vec, vec) -> [vec] - instance VectorStuff ℝ2 where uniformV = pure corners (p1@(V2 x1 y1), p2@(V2 x2 y2)) = @@ -72,7 +71,6 @@ instance VectorStuff ℝ3 where {-# INLINABLE elements #-} {-# INLINABLE corners #-} - ------------------------------------------------------------------------------ -- | Compute the intersection of dimensionality-polymorphic bounding boxes. intersectBoxes @@ -94,7 +92,6 @@ biapp biapp f g (a1, b1) (a2, b2) = (f a1 a2, g b1 b2) {-# INLINABLE biapp #-} - -- | An empty box. emptyBox :: (Applicative f, Num a) => (f a, f a) emptyBox = (pure 0, pure 0) @@ -110,7 +107,6 @@ pointsBox :: (Applicative f, Num a, VectorStuff (f a)) => [f a] -> (f a, f a) pointsBox [] = emptyBox pointsBox (a : as) = (foldr (pointwise min) a as, foldr (pointwise max) a as) - ------------------------------------------------------------------------------ -- | Compute the intersection of dimensionality-polymorphic bounding boxes. unionBoxes :: (VectorStuff (f a), Applicative f, Eq (f a), Num a, Num (f a)) => ℝ -> [(f a, f a)] -> (f a, f a) diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs b/Graphics/Implicit/ObjectUtil/GetImplicit2.hs index 56ae355..7db454d 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs +++ b/Graphics/Implicit/ObjectUtil/GetImplicit2.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -19,8 +20,6 @@ import Data.List (nub) import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared) import Linear (V2(V2)) - - ------------------------------------------------------------------------------ -- | Filter out equal consecutive elements in the list. This function will -- additionally trim the last element of the list if it's equal to the first. @@ -30,7 +29,6 @@ scanUniqueCircular . filter (uncurry (/=)) . circularPairs - ------------------------------------------------------------------------------ -- | Given @[a, b, c, ... n]@, return the pairs @[(a, b), (b, c), ... (n, a)]@. circularPairs :: [a] -> [(a,a)] diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs index 7858487..78eddb5 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs +++ b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) diff --git a/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs b/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs index c9f33b8..ee01402 100644 --- a/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs +++ b/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) @@ -23,7 +24,6 @@ import Graphics.Implicit.ObjectUtil.GetBoxShared (VectorStuff(elements, uniformV import Linear (Metric(dot)) - ------------------------------------------------------------------------------ -- | Normalize a dimensionality-polymorphic vector. normalize @@ -35,7 +35,6 @@ normalize v = let all1s = uniformV @(f ℝ) 1 in abs (product (elements v)) ** (1 / (all1s `dot` all1s)) - -- Get a function that describes the surface of the object. getImplicitShared :: forall obj f diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs index 932c773..319c936 100644 --- a/Graphics/Implicit/Primitives.hs +++ b/Graphics/Implicit/Primitives.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -116,7 +117,6 @@ cube cube False size = Cube size cube True size = translate (fmap (negate . (/ 2)) size) $ Cube size - -- | A conical frustum --- ie. a cylinder with different radii at either end. cylinder2 :: ℝ -- ^ Radius of the cylinder @@ -205,7 +205,6 @@ pattern Shared v <- (preview _Shared -> Just v) where Shared v = _Shared # v - -- | Translate an object by a vector of appropriate dimension. translate :: Object obj vec @@ -332,7 +331,6 @@ implicit -> obj -- ^ Resulting object implicit a b = Shared $ EmbedBoxedObj (a, b) - instance Object SymbolicObj2 ℝ2 where _Shared = prism' Shared2 $ \case Shared2 x -> Just x @@ -347,7 +345,6 @@ instance Object SymbolicObj3 ℝ3 where getBox = getBox3 getImplicit' = getImplicit3 - union :: Object obj vec => [obj] -> obj union = unionR 0 @@ -378,7 +375,6 @@ extrudeM -> SymbolicObj3 extrudeM = ExtrudeM - rotateExtrude :: ℝ -- ^ Angle to sweep to (in rad) -> Either ℝ2 (ℝ -> ℝ2) -- ^ translate diff --git a/Setup.hs b/Setup.hs index b55cb16..b5b28f8 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} import Distribution.Simple main :: IO () main = defaultMain diff --git a/layout/ormolu.sh b/layout/ormolu.sh new file mode 100755 index 0000000..ed19151 --- /dev/null +++ b/layout/ormolu.sh @@ -0,0 +1,92 @@ +#!/usr/bin/env bash + +set -e + +cd "$( dirname "${BASH_SOURCE[0]}" )" + +command -v grep >/dev/null 2>&1 || { echo >&2 "grep is not installed, aborting."; exit 1; } +command -v awk >/dev/null 2>&1 || { echo >&2 "awk is not installed, aborting."; exit 1; } +command -v sed >/dev/null 2>&1 || { echo >&2 "sed is not installed, aborting."; exit 1; } +command -v yq >/dev/null 2>&1 || { echo >&2 "yq is not installed, aborting. See https://github.com/mikefarah/yq"; exit 1; } + +ORMOLU_VERSION=$(cat ormolu.version) +( ormolu -v 2>/dev/null | grep -q $ORMOLU_VERSION ) || ( echo "please install ormolu $ORMOLU_VERSION (eg., run 'cabal install ormolu' and ensure ormolu is on your PATH.)"; exit 1 ) +echo "ormolu version: $ORMOLU_VERSION" + +ARG_ALLOW_DIRTY_WC="0" +ARG_ORMOLU_MODE="inplace" + +USAGE=" +This bash script can either (a) apply ormolu formatting in-place to +all haskell modules in your working copy, or (b) check all modules for +formatting and fail if ormolu needs to be applied. + +(a) is mostly for migrating from manually-formatted projects to +ormolu-formatted ones; (b) can be run in by a continuous integration +service to make sure no branches with non-ormolu formatting make get +merged. + +For every-day dev work, consider using one of the ormolu editor +integrations (see https://github.com/tweag/ormolu#editor-integration). + +USAGE: $0 + -h: show this help. + -f: run even if working copy is dirty. default: ${ARG_ALLOW_DIRTY_WC} + -c: set ormolu mode to 'check'. default: 'inplace' + +" + +# Option parsing: +# https://sookocheff.com/post/bash/parsing-bash-script-arguments-with-shopts/ +while getopts ":fch" opt; do + case ${opt} in + f ) ARG_ALLOW_DIRTY_WC="1" + ;; + c ) ARG_ORMOLU_MODE="check" + ;; + h ) echo "$USAGE" 1>&2 + exit 0 + ;; + esac +done +shift $((OPTIND -1)) + +if [ "$#" -ne 0 ]; then + echo "$USAGE" 1>&2 + exit 1 +fi + +cd ".." + +if [ "$(git status -s | grep -v \?\?)" != "" ]; then + echo "working copy not clean." + if [ "$ARG_ALLOW_DIRTY_WC" == "1" ]; then + echo "running with -f. this will mix ormolu and other changes." + else + echo "run with -f if you want to force mixing ormolu and other changes." + exit 1 + fi +fi + +echo "ormolu mode: $ARG_ORMOLU_MODE" + +FAILURES=0 + +for hsfile in $(git ls-files | grep '\.hsc\?$'); do + FAILED=0 + ormolu --mode $ARG_ORMOLU_MODE --check-idempotence $LANGUAGE_EXTS "$hsfile" || FAILED=1 + if [ "$FAILED" == "1" ]; then + ((++FAILURES)) + echo "$hsfile... *** FAILED" + else + echo "$hsfile... ok" + fi +done + +if [ "$FAILURES" != 0 ]; then + echo "ormolu failed on $FAILURES files." + if [ "$ARG_ORMOLU_MODE" == "check" ]; then + echo -en "\n\nyou can fix this by running 'make format' from the git repo root.\n\n" + fi + exit 1 +fi diff --git a/layout/ormolu.version b/layout/ormolu.version new file mode 100644 index 0000000..473b31b --- /dev/null +++ b/layout/ormolu.version @@ -0,0 +1 @@ +0.1.4.1 diff --git a/layout/rebase-onto-formatter.sh b/layout/rebase-onto-formatter.sh new file mode 100644 index 0000000..0de82b6 --- /dev/null +++ b/layout/rebase-onto-formatter.sh @@ -0,0 +1,125 @@ +#!/usr/bin/env bash + +# written by mheinzel + +set -euo pipefail + +command -v sed >/dev/null 2>&1 || { echo >&2 "sed is not installed, aborting."; exit 1; } + +BASE_COMMIT=${1:-} +TARGET_COMMIT=${2:-} +FORMATTING_COMMAND='make formatf' +USAGE=" +USAGE: $0 BASE_COMMIT TARGET_COMMIT + + BASE_COMMIT: + A commit that contains the changes to formatting version and + config already from TARGET_COMMIT, but not the automatically + applied formatting changes. Must be the first commit on the + branch you are about to rebase (not the one returned by + git-merge-base). It will be removed from the resulting branch. + TARGET_COMMIT: + The commit introducing the formatting that you want to rebase onto. + +Rebase a branch onto changes created by an automated formatter. The script +will keep the (linear) history of the branch intact and make the commits appear +as if the changes had been applied onto the newly-formatted version all along. + +INSTRUCTIONS: +1. Make a copy of your branch (or be prepared to salvage it from reflog). + $ git branch mybranch-backup +2. Find out what the base commit is. +3. Rebase onto the base commit yourself. + $ git rebase \$BASE_COMMIT +4. Make sure the formatting tool is installed with the correct version and settings. + $ stack install ormolu +5. Run this script. + $ $0 \$BASE_COMMIT \$TARGET_COMMIT + +" + +if [ -z "$BASE_COMMIT" ] || [ -z "$TARGET_COMMIT" ] || [ -z "$FORMATTING_COMMAND" ] +then + echo "$USAGE" 1>&2 + exit 1 +fi + +echo "Running the script now. This might take a while..." + +# The general idea is the following: +# +# We have a branch consisting of commits C1, C2, ... on top of our BASE_COMMIT C0. +# Also, from C0 an automated formatting change f was made on some branch (e.g. develop). +# +# C0 ----> C1 ----> C2 ----> ... ----> Cn +# | +# f +# | +# v +# C0' +# +# Now, how do we obtain versions of our commits operating on the formatted code (let's call them Ci')? +# +# C0 ----> C1 ----> C2 ----> ... ----> Cn +# | +# f +# | +# v +# C0' ---> C1' ---> C2' ---> ... ----> Cn' +# +# One useful thing is that since f is defined by an automated tool, +# we know f applied at every commit Ci, resulting in a hypothetical Ci'. +# +# C0 ----> C1 ----> C2 ----> ... ----> Cn +# | | | | +# f f f f +# | | | | +# v v v v +# C0' C1' C2' Cn' +# +# And we can also get its inverse g (applied at Ci') by reverting the commit. +# +# C0 ----> C1 ----> C2 ----> ... ----> Cn +# |^ |^ |^ |^ +# f| f| f| f| +# |g |g |g |g +# v| v| v| v| +# C0' C1' C2' Cn' +# +# Finally, we can get from C(i-1)' to Ci' by composing three arrows: +# - g at C(i-1) +# - Ci +# - f at C1 +# +# C0 ----> C1 ----> C2 ----> ... ----> Cn +# |^ |^ |^ |^ +# f| f| f| f| +# |g |g |g |g +# v| v| v| v| +# C0' ---> C1' ---> C2' ---> ... ----> Cn' + +set -x + +# edit every commit Ci, adding new commits representing f at Ci and it's inverse g +git rebase $BASE_COMMIT~1 --exec "$FORMATTING_COMMAND && git commit -am format && git revert HEAD --no-edit" + +# drop last commit (do not revert formatting at the end of the branch) +git reset HEAD~1 --hard + +# now for every Ci, squash with the previous and next commit (i.e. g at C(i-1) and f at Ci). +# However, we want to use Ci's commit message and author. +# To do this, we run the following command after each group of these 3 commits: +# Ci=$(git rev-parse HEAD~1); git reset --soft HEAD~3; git commit --reuse-message $Ci +# We do an interactive rebase, but instead of editing the commit sequence manually, +# we use sed for that, inserting an `exec` command after every 3 commits. +GIT_SEQUENCE_EDITOR='sed -i -e "4~3s/^\(pick \S* format\)$/\1\nexec Ci=\$(git rev-parse HEAD~1); git reset --soft HEAD~3; git commit --reuse-message \$Ci/"' \ + git rebase --interactive $BASE_COMMIT + +# rebase onto TARGET_COMMIT. +# Annoyingly, we still have this first "format" commit that should already be +# part of the TARGET_COMMIT. So we drop it. +GIT_SEQUENCE_EDITOR='sed -i "1s/pick/drop/"' \ + git rebase --interactive $BASE_COMMIT --onto $TARGET_COMMIT + +echo "Done." +echo "Please check that the history looks as it should and all expected commits are there." diff --git a/programs/Benchmark.hs b/programs/Benchmark.hs index 108bb3f..c839be9 100644 --- a/programs/Benchmark.hs +++ b/programs/Benchmark.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/programs/docgen.hs b/programs/docgen.hs index 435d334..f807338 100644 --- a/programs/docgen.hs +++ b/programs/docgen.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Released under the GNU GPL, see LICENSE diff --git a/programs/extopenscad.hs b/programs/extopenscad.hs index 352a6a9..07e2534 100644 --- a/programs/extopenscad.hs +++ b/programs/extopenscad.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2016, Mike MacHenry (mike.machenry@gmail.com) diff --git a/programs/implicitsnap.hs b/programs/implicitsnap.hs index fca15c9..ac2985a 100644 --- a/programs/implicitsnap.hs +++ b/programs/implicitsnap.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -236,4 +237,3 @@ executeAndExport content callback maybeFormat = ([], [] , _) -> callbackF False False 1 $ scadMessages <> "\n" <> "Nothing to render." _ -> callbackF False False 1 $ scadMessages <> "\n" <> "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?" - diff --git a/programs/parser-bench.hs b/programs/parser-bench.hs index 5aac0bb..efc1e14 100644 --- a/programs/parser-bench.hs +++ b/programs/parser-bench.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com) -- Copyright 2014-2019, Julia Longtin (julial@turinglace.com) diff --git a/tests/ExecSpec/Expr.hs b/tests/ExecSpec/Expr.hs index 3976f36..e09179e 100644 --- a/tests/ExecSpec/Expr.hs +++ b/tests/ExecSpec/Expr.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/tests/ExecSpec/Util.hs b/tests/ExecSpec/Util.hs index a16c59d..98f935f 100644 --- a/tests/ExecSpec/Util.hs +++ b/tests/ExecSpec/Util.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) @@ -18,7 +19,6 @@ import Graphics.Implicit.Definitions (ℝ) -- Expressions, symbols, and values in the OpenScad language. import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum)) - import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr) import Test.Hspec (Expectation, shouldBe) diff --git a/tests/GoldenSpec/Spec.hs b/tests/GoldenSpec/Spec.hs index dcda9db..986b385 100644 --- a/tests/GoldenSpec/Spec.hs +++ b/tests/GoldenSpec/Spec.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} {-# OPTIONS_GHC -fno-warn-missing-import-lists #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} @@ -105,7 +106,6 @@ spec = describe "golden tests" $ do ]) ] - -- These tests were generated by the Arbitrary instance golden "arbitrary1" 1 $ cylinder 16.76324 21.02933 diff --git a/tests/GoldenSpec/Util.hs b/tests/GoldenSpec/Util.hs index 4272d92..4a5151a 100644 --- a/tests/GoldenSpec/Util.hs +++ b/tests/GoldenSpec/Util.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} @@ -10,7 +11,6 @@ import System.Directory (getTemporaryDirectory, doesFileExist) import System.IO (hClose, openTempFile) import Test.Hspec (it, shouldBe, SpecWith) - ------------------------------------------------------------------------------ -- | Construct a golden test for rendering the given 'SymbolicObj3' at the -- specified resolution. On the first run of this test, it will render the @@ -41,7 +41,6 @@ golden name resolution sym = it (name <> " (golden)") $ do then pure () else False `shouldBe` True - ------------------------------------------------------------------------------ -- | Get a temporary filepath with the desired extension. On unix systems, this -- is a file under @/tmp@. Useful for tests that need to write files. diff --git a/tests/Graphics/Implicit/Test/Instances.hs b/tests/Graphics/Implicit/Test/Instances.hs index 58d2136..ec3046c 100644 --- a/tests/Graphics/Implicit/Test/Instances.hs +++ b/tests/Graphics/Implicit/Test/Instances.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014 2015 2016, Julia Longtin (julia.longtin@gmail.com) -- Released under the GNU AGPLV3+, see LICENSE @@ -81,7 +82,6 @@ instance Arbitrary SymbolicObj2 where , pure emptySpace ] - -- TODO(sandy): Also generate all of the extrusion variants. instance Arbitrary SymbolicObj3 where shrink = genericShrink @@ -131,7 +131,6 @@ instance CoArbitrary ℝ2 where instance CoArbitrary ℝ3 where coarbitrary (V3 a b c) = coarbitrary (a, b, c) - instance Arbitrary ExtrudeMScale where shrink = genericShrink arbitrary = oneof @@ -140,7 +139,6 @@ instance Arbitrary ExtrudeMScale where , Fn <$> arbitrary ] - instance Arbitrary (Quaternion ℝ) where arbitrary = do q <- arbitrary @@ -149,21 +147,18 @@ instance Arbitrary (Quaternion ℝ) where then discard else pure $ axisAngle v q - ------------------------------------------------------------------------------ -- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at -- all points (up to an error term of 'epsilon') instance Observe (ℝ2, ()) Insidedness SymbolicObj2 where observe p = insidedness . observe p . getImplicit - ------------------------------------------------------------------------------ -- | Two 'SymbolicObj3's are the same if their 'getImplicit' functions agree at -- all points (up to an error term of 'epsilon') instance Observe (ℝ3, ()) Insidedness SymbolicObj3 where observe p = insidedness . observe p . getImplicit - -- | Generate a small list of 'Arbitrary' elements, splitting the current -- complexity budget between all of them. decayedList :: Arbitrary a => Gen [a] diff --git a/tests/Graphics/Implicit/Test/Utils.hs b/tests/Graphics/Implicit/Test/Utils.hs index 01f5838..602420d 100644 --- a/tests/Graphics/Implicit/Test/Utils.hs +++ b/tests/Graphics/Implicit/Test/Utils.hs @@ -1,9 +1,9 @@ +{- ORMOLU_DISABLE -} module Graphics.Implicit.Test.Utils where import Prelude (drop, (<*>), (<$>), take, length, pure) import Test.QuickCheck ( choose, Gen ) - randomGroups :: [a] -> Gen [[a]] randomGroups [] = pure [] randomGroups as = do diff --git a/tests/ImplicitSpec.hs b/tests/ImplicitSpec.hs index a6b65f2..2b7502e 100644 --- a/tests/ImplicitSpec.hs +++ b/tests/ImplicitSpec.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} @@ -41,7 +42,6 @@ import Graphics.Implicit (extrude) import Graphics.Implicit (cylinder2) import Graphics.Implicit (mirror) - ------------------------------------------------------------------------------ -- Tests showing equivalencies between algebraic formulations of symbolic -- objects, in both 2d and 3d. Equality is observational, based on random @@ -67,7 +67,6 @@ spec = do rotation3dSpec misc3dSpec - ------------------------------------------------------------------------------ -- All the constraints we need in scope to parameterize tests by both 2d and -- 3d symbolic objects. @@ -83,7 +82,6 @@ type TestInfrastructure obj vec test outcome = , Arbitrary vec ) - ------------------------------------------------------------------------------ -- Tests proving that symbolic objects form a monoid. monoidSpec @@ -100,7 +98,6 @@ monoidSpec = describe "monoid laws" $ do prop "(a <> b) <> c = a <> (b <> c)" $ \a b (c :: obj) -> (a <> b) <> c =~= a <> (b <> c) - ------------------------------------------------------------------------------ -- Tests showing that 'translate' is a no-op for both 'emptySpace' and -- 'fullSpace'. Additionally, that 'scale' is a no-op on 'emptySpace' (but not @@ -124,7 +121,6 @@ idempotenceSpec = describe "idempotence" $ do withRounding r . withRounding r' =~= withRounding @obj r' - ------------------------------------------------------------------------------ -- Proofs of the invertability of operations. inverseSpec @@ -148,7 +144,6 @@ inverseSpec = describe "inverses" $ do -- -- scale @obj xyz . scale (invert xyz) -- -- =~= id - ------------------------------------------------------------------------------ -- Proofs that 'fullSpace' is an annhilative element with respect to union. annihilationSpec @@ -163,7 +158,6 @@ annihilationSpec = describe "annihilation" $ do obj <> fullSpace =~= fullSpace @obj - ------------------------------------------------------------------------------ -- Misc proofs regarding 2d rotation. rotation2dSpec :: Spec @@ -188,7 +182,6 @@ rotation2dSpec = describe "2d rotation" $ do rotate rads emptySpace =~= emptySpace - ------------------------------------------------------------------------------ -- Misc proofs regarding 3d rotation. rotation3dSpec :: Spec @@ -226,7 +219,6 @@ rotation3dSpec = describe "3d rotation" $ do rotate3 xyz emptySpace =~= emptySpace - ------------------------------------------------------------------------------ -- Misc tests that make sense only in 3d misc3dSpec :: Spec @@ -238,7 +230,6 @@ misc3dSpec = describe "misc 3d tests" $ do prop "cylinder with negative height is a flipped cylinder with positive height" $ \r1 r2 h -> cylinder2 r1 r2 h =~= mirror (V3 0 0 1) (cylinder2 r1 r2 (-h)) - ------------------------------------------------------------------------------ -- Misc identity proofs that should hold for all symbolic objects. identitySpec @@ -269,7 +260,6 @@ identitySpec = describe "identity" $ do prop "union [a] = a" $ \obj -> union @obj [obj] =~= obj - ------------------------------------------------------------------------------ -- Functions proving symbolic objects form homomorphisms with respect to -- translate and scale. @@ -298,7 +288,6 @@ homomorphismSpec = describe "homomorphism" $ do withRounding @obj r_obj . intersectR r_combo =~= intersectR r_combo . fmap (withRounding r_obj) - ------------------------------------------------------------------------------ -- | Like 'prop', but for tests that are currently expected to fail. failingProp :: Testable prop => String -> prop -> SpecWith () diff --git a/tests/Main.hs b/tests/Main.hs index 1550870..b524711 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2018, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/tests/MessageSpec/Message.hs b/tests/MessageSpec/Message.hs index aa84b24..74eff91 100644 --- a/tests/MessageSpec/Message.hs +++ b/tests/MessageSpec/Message.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/tests/MessageSpec/Util.hs b/tests/MessageSpec/Util.hs index 0778195..b6a50cc 100644 --- a/tests/MessageSpec/Util.hs +++ b/tests/MessageSpec/Util.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) diff --git a/tests/ParserSpec/Expr.hs b/tests/ParserSpec/Expr.hs index bcabc27..9d1c3d5 100644 --- a/tests/ParserSpec/Expr.hs +++ b/tests/ParserSpec/Expr.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/tests/ParserSpec/Statement.hs b/tests/ParserSpec/Statement.hs index 6fccee7..3f12cb0 100644 --- a/tests/ParserSpec/Statement.hs +++ b/tests/ParserSpec/Statement.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com) -- Released under the GNU AGPLV3+, see LICENSE diff --git a/tests/ParserSpec/Util.hs b/tests/ParserSpec/Util.hs index 1aa3e15..6e824bf 100644 --- a/tests/ParserSpec/Util.hs +++ b/tests/ParserSpec/Util.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) diff --git a/tests/PropertySpec.hs b/tests/PropertySpec.hs index c603542..57f80bd 100644 --- a/tests/PropertySpec.hs +++ b/tests/PropertySpec.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} module PropertySpec ( propSpec ) where @@ -5,7 +6,7 @@ module PropertySpec import Test.Hspec (Spec) import PropertySpec.Exec (additionSpec, subtractionSpec, multiplicationSpec, divisionSpec) -propSpec :: Spec +propSpec :: Spec propSpec = do additionSpec subtractionSpec diff --git a/tests/PropertySpec/Exec.hs b/tests/PropertySpec/Exec.hs index bad419f..0e3ec4c 100644 --- a/tests/PropertySpec/Exec.hs +++ b/tests/PropertySpec/Exec.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} module PropertySpec.Exec ( additionSpec , subtractionSpec @@ -33,7 +34,7 @@ instance Show Op where show Mul = "*" show Div = "/" -opName :: Op -> String +opName :: Op -> String opName Add = "addition" opName Sub = "subttraction" opName Mul = "multiplication" diff --git a/tests/TesselationSpec.hs b/tests/TesselationSpec.hs index 9be29ca..3324fc2 100644 --- a/tests/TesselationSpec.hs +++ b/tests/TesselationSpec.hs @@ -1,3 +1,4 @@ +{- ORMOLU_DISABLE -} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ImplicitPrelude #-} @@ -21,7 +22,6 @@ import Graphics.Implicit.Test.Instances () import Control.Monad (join) import Control.Lens (Ixed(ix), (&), (.~) ) - spec :: Spec spec = do describe "getLoops" $ do @@ -74,8 +74,6 @@ spec = do -- 'fail', but let's make sure they have the same number of segments too. length loop `shouldBe` length loop' - - ------------------------------------------------------------------------------ -- | Show that the given loop exists somewhere in the discovered loops. -- Correctly deals with the case where the two loops start at different places. @@ -83,7 +81,6 @@ proveLoop :: (Show a, Eq a) => [a] -> [[a]] -> Expectation proveLoop v loops = join (replicate 2 v) `shouldContain` unloop loops - ------------------------------------------------------------------------------ -- | Generate a loop and random segments that should produce it. The defining -- equation of this generator is tested by "getLoops > loops a loop". @@ -99,7 +96,6 @@ genLoop start = do shuffled_segs <- shuffle segs pure (v, shuffled_segs) - ------------------------------------------------------------------------------ -- | Like 'genLoop', but produces several loops, tagged with an index number. -- For best results, you should call @shuffle . join@ on the resulting segments @@ -117,21 +113,18 @@ genManyLoops start n = do -- and tag it with the index pure (fmap (idx,) v, fmap (fmap (idx,)) segs) - ------------------------------------------------------------------------------ -- | Given a list of lists, insert elements into the 'head' and 'last' of each -- sub-list so that the 'last' of one list is the 'head' of the next. loopify :: [[a]] -> [[a]] loopify as = zipWith (\a -> mappend a . take 1) as $ drop 1 $ join $ repeat as - ------------------------------------------------------------------------------ -- | Remove sequential elements in a list. Additionally, this function removes -- the 'head' of the list, because conceptully it is also the 'last'. unloop :: Eq a => [[a]] -> [a] unloop = drop 1 . fmap head . group . join - ------------------------------------------------------------------------------ -- | Insert an element into the middle (not 'head' or 'last') of a list. insertMiddle :: [a] -> a -> Gen [a] @@ -142,7 +135,6 @@ insertMiddle as a = do i <- choose (1, n - 1) pure $ insertAt i a as - ------------------------------------------------------------------------------ -- | Helper function to insert an element into a list at a given position. --