Haskell-Things/ImplicitCAD
1
1
Fork 0
mirror of https://github.com/Haskell-Things/ImplicitCAD.git synced 2024-09-11 04:55:41 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #376 from fisx/introduce-ormolu

Browse Source 
Introduce ormolu
This commit is contained in:
Julia Longtin 2021-06-04 19:09:59 +00:00 committed by GitHub
commit 87f2aee4b3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
80 changed files with 347 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
.github/workflows/ormolu.yaml vendored Normal file
View File

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

1
Examples/example11.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Example 11 - the union of a square and a circle.
import Graphics.Implicit

1
Examples/example12.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Example 12 - the rounded union of a square and a circle.
import Control.Applicative (pure)
import Graphics.Implicit

1
Examples/example13.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Example 13 - the rounded union of a cube and a sphere.
import Control.Applicative (pure)
import Graphics.Implicit

1
Examples/example16.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
import Control.Applicative (pure)
import Graphics.Implicit
import Graphics.Implicit.Definitions

1
Examples/example17.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Example 17, pulled from our benchmarking suite.
import Control.Applicative (pure)
import Prelude ((<$>), ($), zipWith3, fmap, fromIntegral, (*), (/), Bool(..))

2
Graphics/Implicit.hs
View File

@ -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)@.

9
Graphics/Implicit/Definitions.hs
View File

@ -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])

1
Graphics/Implicit/Export.hs
View File

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

1
Graphics/Implicit/Export/DiscreteAproxable.hs
View File

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

1
Graphics/Implicit/Export/NormedTriangleMeshFormats.hs
View File

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

1
Graphics/Implicit/Export/PolylineFormats.hs
View File

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

2
Graphics/Implicit/Export/RayTrace.hs
View File

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

1
Graphics/Implicit/Export/Render.hs
View File

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

1
Graphics/Implicit/Export/Render/Definitions.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU AGPLV3+, see LICENSE

1
Graphics/Implicit/Export/Render/GetLoops.hs
View File

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

3
Graphics/Implicit/Export/Render/GetSegs.hs
View File

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

1
Graphics/Implicit/Export/Render/HandlePolylines.hs
View File

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

1
Graphics/Implicit/Export/Render/HandleSquares.hs
View File

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

1
Graphics/Implicit/Export/Render/Interpolate.hs
View File

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

1
Graphics/Implicit/Export/Render/RefineSegs.hs
View File

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

3
Graphics/Implicit/Export/Render/TesselateLoops.hs
View File

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

1
Graphics/Implicit/Export/Symbolic/Rebound2.hs
View File

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

1
Graphics/Implicit/Export/Symbolic/Rebound3.hs
View File

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

6
Graphics/Implicit/Export/SymbolicFormats.hs
View File

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

1
Graphics/Implicit/Export/SymbolicObj2.hs
View File

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

1
Graphics/Implicit/Export/SymbolicObj3.hs
View File

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

1
Graphics/Implicit/Export/TextBuilderUtils.hs
View File

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

1
Graphics/Implicit/Export/TriangleMeshFormats.hs
View File

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

1
Graphics/Implicit/Export/Util.hs
View File

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

1
Graphics/Implicit/ExtOpenScad.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Default.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Definitions.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Eval/Constant.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Eval/Expr.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Eval/Statement.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Parser/Expr.hs
View File

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

3
Graphics/Implicit/ExtOpenScad/Parser/Lexer.hs
View File

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

2
Graphics/Implicit/ExtOpenScad/Parser/Statement.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Parser/Util.hs
View File

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

3
Graphics/Implicit/ExtOpenScad/Primitives.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Util/OVal.hs
View File

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

1
Graphics/Implicit/ExtOpenScad/Util/StateC.hs
View File

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

1
Graphics/Implicit/FastIntUtil.hs
View File

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

1
Graphics/Implicit/IntegralUtil.hs
View File

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

2
Graphics/Implicit/MathUtil.hs
View File

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

1
Graphics/Implicit/ObjectUtil.hs
View File

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

3
Graphics/Implicit/ObjectUtil/GetBox2.hs
View File

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

2
Graphics/Implicit/ObjectUtil/GetBox3.hs
View File

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

6
Graphics/Implicit/ObjectUtil/GetBoxShared.hs
View File

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

4
Graphics/Implicit/ObjectUtil/GetImplicit2.hs
View File

@ -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)]

1
Graphics/Implicit/ObjectUtil/GetImplicit3.hs
View File

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

3
Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
View File

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

6
Graphics/Implicit/Primitives.hs
View File

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

1
Setup.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
import Distribution.Simple
main :: IO ()
main = defaultMain

92
layout/ormolu.sh Executable file
View File

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

1
layout/ormolu.version Normal file
View File

@ -0,0 +1 @@
0.1.4.1

125
layout/rebase-onto-formatter.sh Normal file
View File

@ -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."

1
programs/Benchmark.hs
View File

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

1
programs/docgen.hs
View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE

1
programs/extopenscad.hs
View File

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

2
programs/implicitsnap.hs
View File

@ -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?"

1
programs/parser-bench.hs
View File

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

1
tests/ExecSpec/Expr.hs
View File

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

2
tests/ExecSpec/Util.hs
View File

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

2
tests/GoldenSpec/Spec.hs
View File

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

3
tests/GoldenSpec/Util.hs
View File

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

7
tests/Graphics/Implicit/Test/Instances.hs
View File

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

2
tests/Graphics/Implicit/Test/Utils.hs
View File

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

13
tests/ImplicitSpec.hs
View File

@ -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 ()

1
tests/Main.hs
View File

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

1
tests/MessageSpec/Message.hs
View File

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

1
tests/MessageSpec/Util.hs
View File

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

1
tests/ParserSpec/Expr.hs
View File

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

1
tests/ParserSpec/Statement.hs
View File

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

1
tests/ParserSpec/Util.hs
View File

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

3
tests/PropertySpec.hs
View File

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

3
tests/PropertySpec/Exec.hs
View File

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

10
tests/TesselationSpec.hs
View File

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