Merge pull request #376 from fisx/introduce-ormolu

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

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'

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -195,7 +196,6 @@ writePNG2
-> IO () -> IO ()
writePNG2 = Export.writePNG writePNG2 = Export.writePNG
-- | Export a PNG of the 'SymbolicObj3'. The projection is with a front-facing -- | 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 -- camera, so the coordinate system is @(left to right, front to back, down to
-- up)@. -- up)@.

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, 2017, 2018, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, 2017, 2018, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.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 EmbedBoxedObj _ -> showCon "implicit" @| Blackhole
WithRounding r obj -> showCon "withRounding" @| r @| obj WithRounding r obj -> showCon "withRounding" @| r @| obj
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | A type whose show instance is a hole @_@. Used for giving 'Show' instances -- | A type whose show instance is a hole @_@. Used for giving 'Show' instances
-- to data types which contain functions or other unshowable things. -- to data types which contain functions or other unshowable things.
@ -256,7 +256,6 @@ data Blackhole = Blackhole
instance Show Blackhole where instance Show Blackhole where
show _ = "_" show _ = "_"
newtype ObjectContext = ObjectContext newtype ObjectContext = ObjectContext
{ objectRounding :: { objectRounding ::
} deriving (Eq, Ord, Show) } deriving (Eq, Ord, Show)
@ -266,7 +265,6 @@ defaultObjectContext = ObjectContext
{ objectRounding = 0 { objectRounding = 0
} }
-- | A symbolic 2D object format. -- | A symbolic 2D object format.
-- We want to have symbolic objects so that we can -- We want to have symbolic objects so that we can
-- accelerate rendering & give ideal meshes for simple -- accelerate rendering & give ideal meshes for simple
@ -293,13 +291,10 @@ instance Show SymbolicObj2 where
Rotate2 v obj -> showCon "rotate" @| v @| obj Rotate2 v obj -> showCon "rotate" @| v @| obj
Shared2 obj -> flip showsPrec obj Shared2 obj -> flip showsPrec obj
-- | Semigroup under 'Graphic.Implicit.Primitives.union'. -- | Semigroup under 'Graphic.Implicit.Primitives.union'.
instance Semigroup SymbolicObj2 where instance Semigroup SymbolicObj2 where
a <> b = Shared2 (UnionR 0 [a, b]) a <> b = Shared2 (UnionR 0 [a, b])
-- | Monoid under 'Graphic.Implicit.Primitives.union'. -- | Monoid under 'Graphic.Implicit.Primitives.union'.
instance Monoid SymbolicObj2 where instance Monoid SymbolicObj2 where
mempty = Shared2 Empty mempty = Shared2 Empty
@ -352,7 +347,6 @@ instance Show SymbolicObj3 where
showCon "extrudeOnEdgeOf" @| s @| s1 showCon "extrudeOnEdgeOf" @| s @| s1
Shared3 s -> flip showsPrec s Shared3 s -> flip showsPrec s
infixl 2 @|| infixl 2 @||
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | ImplicitCAD uses the pattern @Either a (b -> c)@ for many of its -- | 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 Left a -> showCon "Left" @| a
Right _ -> showCon "Right" @| Blackhole Right _ -> showCon "Right" @| Blackhole
-- | Semigroup under 'Graphic.Implicit.Primitives.union'. -- | Semigroup under 'Graphic.Implicit.Primitives.union'.
instance Semigroup SymbolicObj3 where instance Semigroup SymbolicObj3 where
a <> b = Shared3 (UnionR 0 [a, b]) a <> b = Shared3 (UnionR 0 [a, b])

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
-- Copyright (C) 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright (C) 2015 2016, Mike MacHenry (mike.machenry@gmail.com)

View File

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

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- 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 Nothing -> defaultColor

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -30,7 +31,6 @@ import Linear (V2(V2))
To allow data sharing, lots of values we To allow data sharing, lots of values we
could calculate are instead arguments. could calculate are instead arguments.
positions obj values positions obj values
--------- ---------- --------- ----------
@ -38,7 +38,6 @@ import Linear (V2(V2))
: : => : : : : => : :
(x1,y1) .. (x2,y1) x1y1 .. x2y2 (x1,y1) .. (x2,y1) x1y1 .. x2y2
mid points mid points
---------- ----------

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2012, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2012, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

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

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -23,7 +24,6 @@ tesselateLoop _ _ [] = []
tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [Tris $ TriangleMesh [Triangle (a,b,c)]] 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]) ] 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]) ] else early_tris <> [Triangle (a,b,mid) | (a,b) <- zip path (tail path <> [head path]) ]
shrinkLoop :: -> [3] -> -> Obj3 -> ([Triangle], [3]) shrinkLoop :: -> [3] -> -> Obj3 -> ([Triangle], [3])
shrinkLoop _ path@[a,b,c] res obj = shrinkLoop _ path@[a,b,c] res obj =

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com) -- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -54,7 +55,6 @@ call = callToken ("[", "]")
callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
callNaked = callToken ("", "") callNaked = callToken ("", "")
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Class which allows us to build the contained objects in 'buildShared'. -- | Class which allows us to build the contained objects in 'buildShared'.
class Build obj where class Build obj where
@ -66,7 +66,6 @@ instance Build SymbolicObj2 where
instance Build SymbolicObj3 where instance Build SymbolicObj3 where
build = buildS3 build = buildS3
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Unpack a dimensionality-polymorphic vector into multiple arguments. -- | Unpack a dimensionality-polymorphic vector into multiple arguments.
vectAsArgs :: VectorStuff vec => vec -> [Builder] vectAsArgs :: VectorStuff vec => vec -> [Builder]
@ -77,7 +76,6 @@ vectAsArgs = fmap bf . elements
bvect :: VectorStuff vec => vec -> Builder bvect :: VectorStuff vec => vec -> Builder
bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]" bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]"
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Build the common combinators. -- | Build the common combinators.
buildShared :: forall obj vec. (Build obj, VectorStuff vec) => SharedObj obj vec -> Reader Builder 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(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." buildShared (WithRounding _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
-- | First, the 3D objects. -- | First, the 3D objects.
buildS3 :: SymbolicObj3 -> Reader Builder buildS3 :: SymbolicObj3 -> Reader Builder
@ -143,7 +140,6 @@ buildS3 (Rotate3 q obj) =
buildS3 (Extrude obj h) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj] buildS3 (Extrude obj h) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj]
-- FIXME: handle scale, center. -- FIXME: handle scale, center.
buildS3 (ExtrudeM twist scale (Left translate) obj (Left height)) |isScaleID scale && translate == V2 0 0 = do buildS3 (ExtrudeM twist scale (Left translate) obj (Left height)) |isScaleID scale && translate == V2 0 0 = do
res <- ask res <- ask

View File

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

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014, 2015, 2016 Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014, 2015, 2016 Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

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

View File

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

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014-2019 , Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014-2019 , Julia Longtin (julial@turinglace.com)
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com) -- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)

View File

@ -1,9 +1,9 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com) -- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
-- Allow us to use string literals for Text -- Allow us to use string literals for Text
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@ -139,7 +139,6 @@ matchCAT = P.reservedOp lexer "++" >> pure "++"
matchEXP :: GenParser Char st Char matchEXP :: GenParser Char st Char
matchEXP = P.reservedOp lexer "^" >> pure '^' matchEXP = P.reservedOp lexer "^" >> pure '^'
-- | match something between two ends. -- | match something between two ends.
surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy leftTok middle rightTok = between (matchTok leftTok) (matchTok rightTok) middle surroundedBy leftTok middle rightTok = between (matchTok leftTok) (matchTok rightTok) middle

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -48,7 +49,6 @@ parseProgram = parse program where
program :: GenParser Char st [StatementI] program :: GenParser Char st [StatementI]
program = removeNoOps <$> (whiteSpace *> many (computation A1) <* eof) program = removeNoOps <$> (whiteSpace *> many (computation A1) <* eof)
-- | A computable block of code in our openscad-like programming language. -- | A computable block of code in our openscad-like programming language.
computation :: CompIdx -> GenParser Char st StatementI computation :: CompIdx -> GenParser Char st StatementI
computation A1 = computation A1 =

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -227,7 +228,6 @@ cylinder = moduleWithoutSuite "cylinder" $ \_ _ -> do
`doc` "top diameter; overrides d" `doc` "top diameter; overrides d"
pure (diameter/2, diameter1/2, diameter2/2) pure (diameter/2, diameter1/2, diameter2/2)
h :: Either 2 <- argument "h" h :: Either 2 <- argument "h"
`defaultTo` Left 1 `defaultTo` Left 1
`doc` "height of cylinder" `doc` "height of cylinder"
@ -485,7 +485,6 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \_ children -> do
. rotateExtrudeDegrees totalRot translateArg rotateArg . rotateExtrudeDegrees totalRot translateArg rotateArg
) children ) children
-- | Like 'Prim.rotateExtrude', but operates in degrees instead of radians. -- | Like 'Prim.rotateExtrude', but operates in degrees instead of radians.
-- This is a shim for scad, which expects this function to operate in degrees. -- This is a shim for scad, which expects this function to operate in degrees.
rotateExtrudeDegrees rotateExtrudeDegrees

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- 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 tmap2 (presObj:) $ packSome otherBoxedObjs box
packSome [] _ = ([], []) packSome [] _ = ([], [])
-- | Reflect a vector across a hyperplane defined by its normal vector. -- | 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 -- From https://en.wikipedia.org/wiki/Reflection_(mathematics)#Reflection_through_a_hyperplane_in_n_dimensions

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -21,7 +22,6 @@ import Graphics.Implicit.ObjectUtil.GetBoxShared (emptyBox, corners, outsetBox,
-- To construct vectors of s. -- To construct vectors of s.
import Linear (V2(V2)) import Linear (V2(V2))
-- Get a Box2 around the given object. -- Get a Box2 around the given object.
getBox2 :: SymbolicObj2 -> Box2 getBox2 :: SymbolicObj2 -> Box2
-- Primitives -- Primitives
@ -35,7 +35,6 @@ getBox2 (Rotate2 θ symbObj) =
in pointsBox $ fmap rotate $ corners $ getBox2 symbObj in pointsBox $ fmap rotate $ corners $ getBox2 symbObj
getBox2 (Shared2 obj) = getBoxShared obj getBox2 (Shared2 obj) = getBoxShared obj
-- | Define a Box2 around the given object, and the space it occupies while rotating about the center point. -- | 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. -- Note: No implementations for Square, Translate2, or Scale2 as they would be identical to the fallthrough.
getBox2R :: SymbolicObj2 -> -> Box2 getBox2R :: SymbolicObj2 -> -> Box2

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
@ -145,7 +146,6 @@ getBox3 (RotateExtrude rot (Right f) rotate symbObj) =
in in
(V3 (-r) (-r) $ y1 + ymin', V3 r r $ y2 + ymax') (V3 (-r) (-r) $ y1 + ymin', V3 r r $ y2 + ymax')
unpack :: V2 a -> (a, a) unpack :: V2 a -> (a, a)
unpack (V2 a b) = (a, b) unpack (V2 a b) = (a, b)

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- 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 Data.Foldable (Foldable(toList))
import Control.Applicative (Applicative(liftA2)) import Control.Applicative (Applicative(liftA2))
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Ad-hoc methods we need to share code between 2D and 3D. With the exception -- | 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, -- 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. -- | Given a bounding box, produce the points at each corner.
corners :: (vec, vec) -> [vec] corners :: (vec, vec) -> [vec]
instance VectorStuff 2 where instance VectorStuff 2 where
uniformV = pure uniformV = pure
corners (p1@(V2 x1 y1), p2@(V2 x2 y2)) = corners (p1@(V2 x1 y1), p2@(V2 x2 y2)) =
@ -72,7 +71,6 @@ instance VectorStuff 3 where
{-# INLINABLE elements #-} {-# INLINABLE elements #-}
{-# INLINABLE corners #-} {-# INLINABLE corners #-}
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Compute the intersection of dimensionality-polymorphic bounding boxes. -- | Compute the intersection of dimensionality-polymorphic bounding boxes.
intersectBoxes intersectBoxes
@ -94,7 +92,6 @@ biapp
biapp f g (a1, b1) (a2, b2) = (f a1 a2, g b1 b2) biapp f g (a1, b1) (a2, b2) = (f a1 a2, g b1 b2)
{-# INLINABLE biapp #-} {-# INLINABLE biapp #-}
-- | An empty box. -- | An empty box.
emptyBox :: (Applicative f, Num a) => (f a, f a) emptyBox :: (Applicative f, Num a) => (f a, f a)
emptyBox = (pure 0, pure 0) 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 [] = emptyBox
pointsBox (a : as) = (foldr (pointwise min) a as, foldr (pointwise max) a as) pointsBox (a : as) = (foldr (pointwise min) a as, foldr (pointwise max) a as)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Compute the intersection of dimensionality-polymorphic bounding boxes. -- | 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) unionBoxes :: (VectorStuff (f a), Applicative f, Eq (f a), Num a, Num (f a)) => -> [(f a, f a)] -> (f a, f a)

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -19,8 +20,6 @@ import Data.List (nub)
import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared) import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared)
import Linear (V2(V2)) import Linear (V2(V2))
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Filter out equal consecutive elements in the list. This function will -- | 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. -- additionally trim the last element of the list if it's equal to the first.
@ -30,7 +29,6 @@ scanUniqueCircular
. filter (uncurry (/=)) . filter (uncurry (/=))
. circularPairs . circularPairs
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Given @[a, b, c, ... n]@, return the pairs @[(a, b), (b, c), ... (n, a)]@. -- | Given @[a, b, c, ... n]@, return the pairs @[(a, b), (b, c), ... (n, a)]@.
circularPairs :: [a] -> [(a,a)] circularPairs :: [a] -> [(a,a)]

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- 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)) import Linear (Metric(dot))
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Normalize a dimensionality-polymorphic vector. -- | Normalize a dimensionality-polymorphic vector.
normalize normalize
@ -35,7 +35,6 @@ normalize v =
let all1s = uniformV @(f ) 1 let all1s = uniformV @(f ) 1
in abs (product (elements v)) ** (1 / (all1s `dot` all1s)) in abs (product (elements v)) ** (1 / (all1s `dot` all1s))
-- Get a function that describes the surface of the object. -- Get a function that describes the surface of the object.
getImplicitShared getImplicitShared
:: forall obj f :: forall obj f

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -116,7 +117,6 @@ cube
cube False size = Cube size cube False size = Cube size
cube True size = translate (fmap (negate . (/ 2)) 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. -- | A conical frustum --- ie. a cylinder with different radii at either end.
cylinder2 :: cylinder2 ::
-- ^ Radius of the cylinder -- ^ Radius of the cylinder
@ -205,7 +205,6 @@ pattern Shared v <- (preview _Shared -> Just v)
where where
Shared v = _Shared # v Shared v = _Shared # v
-- | Translate an object by a vector of appropriate dimension. -- | Translate an object by a vector of appropriate dimension.
translate translate
:: Object obj vec :: Object obj vec
@ -332,7 +331,6 @@ implicit
-> obj -- ^ Resulting object -> obj -- ^ Resulting object
implicit a b = Shared $ EmbedBoxedObj (a, b) implicit a b = Shared $ EmbedBoxedObj (a, b)
instance Object SymbolicObj2 2 where instance Object SymbolicObj2 2 where
_Shared = prism' Shared2 $ \case _Shared = prism' Shared2 $ \case
Shared2 x -> Just x Shared2 x -> Just x
@ -347,7 +345,6 @@ instance Object SymbolicObj3 3 where
getBox = getBox3 getBox = getBox3
getImplicit' = getImplicit3 getImplicit' = getImplicit3
union :: Object obj vec => [obj] -> obj union :: Object obj vec => [obj] -> obj
union = unionR 0 union = unionR 0
@ -378,7 +375,6 @@ extrudeM
-> SymbolicObj3 -> SymbolicObj3
extrudeM = ExtrudeM extrudeM = ExtrudeM
rotateExtrude rotateExtrude
:: -- ^ Angle to sweep to (in rad) :: -- ^ Angle to sweep to (in rad)
-> Either 2 ( -> 2) -- ^ translate -> Either 2 ( -> 2) -- ^ translate

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
import Distribution.Simple import Distribution.Simple
main :: IO () main :: IO ()
main = defaultMain 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

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
-- Copyright (C) 2014 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright (C) 2014 2016, Mike MacHenry (mike.machenry@gmail.com)

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com) -- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE -- 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" <> "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?" _ -> callbackF False False 1 $ scadMessages <> "\n" <> "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?"

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com) -- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com) -- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.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. -- Expressions, symbols, and values in the OpenScad language.
import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum)) import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum))
import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr) import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr)
import Test.Hspec (Expectation, shouldBe) import Test.Hspec (Expectation, shouldBe)

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} {-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}
@ -105,7 +106,6 @@ spec = describe "golden tests" $ do
]) ])
] ]
-- These tests were generated by the Arbitrary instance -- These tests were generated by the Arbitrary instance
golden "arbitrary1" 1 $ golden "arbitrary1" 1 $
cylinder 16.76324 21.02933 cylinder 16.76324 21.02933

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
@ -10,7 +11,6 @@ import System.Directory (getTemporaryDirectory, doesFileExist)
import System.IO (hClose, openTempFile) import System.IO (hClose, openTempFile)
import Test.Hspec (it, shouldBe, SpecWith) import Test.Hspec (it, shouldBe, SpecWith)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Construct a golden test for rendering the given 'SymbolicObj3' at the -- | Construct a golden test for rendering the given 'SymbolicObj3' at the
-- specified resolution. On the first run of this test, it will render 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 () then pure ()
else False `shouldBe` True else False `shouldBe` True
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Get a temporary filepath with the desired extension. On unix systems, this -- | 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. -- is a file under @/tmp@. Useful for tests that need to write files.

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015 2016, Julia Longtin (julia.longtin@gmail.com) -- Copyright (C) 2014 2015 2016, Julia Longtin (julia.longtin@gmail.com)
-- Released under the GNU AGPLV3+, see LICENSE -- Released under the GNU AGPLV3+, see LICENSE
@ -81,7 +82,6 @@ instance Arbitrary SymbolicObj2 where
, pure emptySpace , pure emptySpace
] ]
-- TODO(sandy): Also generate all of the extrusion variants. -- TODO(sandy): Also generate all of the extrusion variants.
instance Arbitrary SymbolicObj3 where instance Arbitrary SymbolicObj3 where
shrink = genericShrink shrink = genericShrink
@ -131,7 +131,6 @@ instance CoArbitrary 2 where
instance CoArbitrary 3 where instance CoArbitrary 3 where
coarbitrary (V3 a b c) = coarbitrary (a, b, c) coarbitrary (V3 a b c) = coarbitrary (a, b, c)
instance Arbitrary ExtrudeMScale where instance Arbitrary ExtrudeMScale where
shrink = genericShrink shrink = genericShrink
arbitrary = oneof arbitrary = oneof
@ -140,7 +139,6 @@ instance Arbitrary ExtrudeMScale where
, Fn <$> arbitrary , Fn <$> arbitrary
] ]
instance Arbitrary (Quaternion ) where instance Arbitrary (Quaternion ) where
arbitrary = do arbitrary = do
q <- arbitrary q <- arbitrary
@ -149,21 +147,18 @@ instance Arbitrary (Quaternion ) where
then discard then discard
else pure $ axisAngle v q else pure $ axisAngle v q
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at -- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at
-- all points (up to an error term of 'epsilon') -- all points (up to an error term of 'epsilon')
instance Observe (2, ()) Insidedness SymbolicObj2 where instance Observe (2, ()) Insidedness SymbolicObj2 where
observe p = insidedness . observe p . getImplicit observe p = insidedness . observe p . getImplicit
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Two 'SymbolicObj3's are the same if their 'getImplicit' functions agree at -- | Two 'SymbolicObj3's are the same if their 'getImplicit' functions agree at
-- all points (up to an error term of 'epsilon') -- all points (up to an error term of 'epsilon')
instance Observe (3, ()) Insidedness SymbolicObj3 where instance Observe (3, ()) Insidedness SymbolicObj3 where
observe p = insidedness . observe p . getImplicit observe p = insidedness . observe p . getImplicit
-- | Generate a small list of 'Arbitrary' elements, splitting the current -- | Generate a small list of 'Arbitrary' elements, splitting the current
-- complexity budget between all of them. -- complexity budget between all of them.
decayedList :: Arbitrary a => Gen [a] decayedList :: Arbitrary a => Gen [a]

View File

@ -1,9 +1,9 @@
{- ORMOLU_DISABLE -}
module Graphics.Implicit.Test.Utils where module Graphics.Implicit.Test.Utils where
import Prelude (drop, (<*>), (<$>), take, length, pure) import Prelude (drop, (<*>), (<$>), take, length, pure)
import Test.QuickCheck ( choose, Gen ) import Test.QuickCheck ( choose, Gen )
randomGroups :: [a] -> Gen [[a]] randomGroups :: [a] -> Gen [[a]]
randomGroups [] = pure [] randomGroups [] = pure []
randomGroups as = do randomGroups as = do

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
@ -41,7 +42,6 @@ import Graphics.Implicit (extrude)
import Graphics.Implicit (cylinder2) import Graphics.Implicit (cylinder2)
import Graphics.Implicit (mirror) import Graphics.Implicit (mirror)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Tests showing equivalencies between algebraic formulations of symbolic -- Tests showing equivalencies between algebraic formulations of symbolic
-- objects, in both 2d and 3d. Equality is observational, based on random -- objects, in both 2d and 3d. Equality is observational, based on random
@ -67,7 +67,6 @@ spec = do
rotation3dSpec rotation3dSpec
misc3dSpec misc3dSpec
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- All the constraints we need in scope to parameterize tests by both 2d and -- All the constraints we need in scope to parameterize tests by both 2d and
-- 3d symbolic objects. -- 3d symbolic objects.
@ -83,7 +82,6 @@ type TestInfrastructure obj vec test outcome =
, Arbitrary vec , Arbitrary vec
) )
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Tests proving that symbolic objects form a monoid. -- Tests proving that symbolic objects form a monoid.
monoidSpec monoidSpec
@ -100,7 +98,6 @@ monoidSpec = describe "monoid laws" $ do
prop "(a <> b) <> c = a <> (b <> c)" $ \a b (c :: obj) -> prop "(a <> b) <> c = a <> (b <> c)" $ \a b (c :: obj) ->
(a <> b) <> c =~= a <> (b <> c) (a <> b) <> c =~= a <> (b <> c)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Tests showing that 'translate' is a no-op for both 'emptySpace' and -- Tests showing that 'translate' is a no-op for both 'emptySpace' and
-- 'fullSpace'. Additionally, that 'scale' is a no-op on 'emptySpace' (but not -- '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 r . withRounding r'
=~= withRounding @obj r' =~= withRounding @obj r'
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Proofs of the invertability of operations. -- Proofs of the invertability of operations.
inverseSpec inverseSpec
@ -148,7 +144,6 @@ inverseSpec = describe "inverses" $ do
-- -- scale @obj xyz . scale (invert xyz) -- -- scale @obj xyz . scale (invert xyz)
-- -- =~= id -- -- =~= id
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Proofs that 'fullSpace' is an annhilative element with respect to union. -- Proofs that 'fullSpace' is an annhilative element with respect to union.
annihilationSpec annihilationSpec
@ -163,7 +158,6 @@ annihilationSpec = describe "annihilation" $ do
obj <> fullSpace obj <> fullSpace
=~= fullSpace @obj =~= fullSpace @obj
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Misc proofs regarding 2d rotation. -- Misc proofs regarding 2d rotation.
rotation2dSpec :: Spec rotation2dSpec :: Spec
@ -188,7 +182,6 @@ rotation2dSpec = describe "2d rotation" $ do
rotate rads emptySpace rotate rads emptySpace
=~= emptySpace =~= emptySpace
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Misc proofs regarding 3d rotation. -- Misc proofs regarding 3d rotation.
rotation3dSpec :: Spec rotation3dSpec :: Spec
@ -226,7 +219,6 @@ rotation3dSpec = describe "3d rotation" $ do
rotate3 xyz emptySpace rotate3 xyz emptySpace
=~= emptySpace =~= emptySpace
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Misc tests that make sense only in 3d -- Misc tests that make sense only in 3d
misc3dSpec :: Spec 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 -> 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)) cylinder2 r1 r2 h =~= mirror (V3 0 0 1) (cylinder2 r1 r2 (-h))
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Misc identity proofs that should hold for all symbolic objects. -- Misc identity proofs that should hold for all symbolic objects.
identitySpec identitySpec
@ -269,7 +260,6 @@ identitySpec = describe "identity" $ do
prop "union [a] = a" $ \obj -> prop "union [a] = a" $ \obj ->
union @obj [obj] =~= obj union @obj [obj] =~= obj
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Functions proving symbolic objects form homomorphisms with respect to -- Functions proving symbolic objects form homomorphisms with respect to
-- translate and scale. -- translate and scale.
@ -298,7 +288,6 @@ homomorphismSpec = describe "homomorphism" $ do
withRounding @obj r_obj . intersectR r_combo withRounding @obj r_obj . intersectR r_combo
=~= intersectR r_combo . fmap (withRounding r_obj) =~= intersectR r_combo . fmap (withRounding r_obj)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Like 'prop', but for tests that are currently expected to fail. -- | Like 'prop', but for tests that are currently expected to fail.
failingProp :: Testable prop => String -> prop -> SpecWith () failingProp :: Testable prop => String -> prop -> SpecWith ()

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)

View File

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

View File

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

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca) -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com) -- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com) -- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
module PropertySpec module PropertySpec
( propSpec ( propSpec
) where ) where
@ -5,7 +6,7 @@ module PropertySpec
import Test.Hspec (Spec) import Test.Hspec (Spec)
import PropertySpec.Exec (additionSpec, subtractionSpec, multiplicationSpec, divisionSpec) import PropertySpec.Exec (additionSpec, subtractionSpec, multiplicationSpec, divisionSpec)
propSpec :: Spec propSpec :: Spec
propSpec = do propSpec = do
additionSpec additionSpec
subtractionSpec subtractionSpec

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
module PropertySpec.Exec module PropertySpec.Exec
( additionSpec ( additionSpec
, subtractionSpec , subtractionSpec
@ -33,7 +34,7 @@ instance Show Op where
show Mul = "*" show Mul = "*"
show Div = "/" show Div = "/"
opName :: Op -> String opName :: Op -> String
opName Add = "addition" opName Add = "addition"
opName Sub = "subttraction" opName Sub = "subttraction"
opName Mul = "multiplication" opName Mul = "multiplication"

View File

@ -1,3 +1,4 @@
{- ORMOLU_DISABLE -}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ImplicitPrelude #-} {-# LANGUAGE ImplicitPrelude #-}
@ -21,7 +22,6 @@ import Graphics.Implicit.Test.Instances ()
import Control.Monad (join) import Control.Monad (join)
import Control.Lens (Ixed(ix), (&), (.~) ) import Control.Lens (Ixed(ix), (&), (.~) )
spec :: Spec spec :: Spec
spec = do spec = do
describe "getLoops" $ do describe "getLoops" $ do
@ -74,8 +74,6 @@ spec = do
-- 'fail', but let's make sure they have the same number of segments too. -- 'fail', but let's make sure they have the same number of segments too.
length loop `shouldBe` length loop' length loop `shouldBe` length loop'
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Show that the given loop exists somewhere in the discovered loops. -- | Show that the given loop exists somewhere in the discovered loops.
-- Correctly deals with the case where the two loops start at different places. -- 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 = proveLoop v loops =
join (replicate 2 v) `shouldContain` unloop loops join (replicate 2 v) `shouldContain` unloop loops
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Generate a loop and random segments that should produce it. The defining -- | Generate a loop and random segments that should produce it. The defining
-- equation of this generator is tested by "getLoops > loops a loop". -- equation of this generator is tested by "getLoops > loops a loop".
@ -99,7 +96,6 @@ genLoop start = do
shuffled_segs <- shuffle segs shuffled_segs <- shuffle segs
pure (v, shuffled_segs) pure (v, shuffled_segs)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Like 'genLoop', but produces several loops, tagged with an index number. -- | Like 'genLoop', but produces several loops, tagged with an index number.
-- For best results, you should call @shuffle . join@ on the resulting segments -- 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 -- and tag it with the index
pure (fmap (idx,) v, fmap (fmap (idx,)) segs) pure (fmap (idx,) v, fmap (fmap (idx,)) segs)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Given a list of lists, insert elements into the 'head' and 'last' of each -- | 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. -- sub-list so that the 'last' of one list is the 'head' of the next.
loopify :: [[a]] -> [[a]] loopify :: [[a]] -> [[a]]
loopify as = zipWith (\a -> mappend a . take 1) as $ drop 1 $ join $ repeat as loopify as = zipWith (\a -> mappend a . take 1) as $ drop 1 $ join $ repeat as
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Remove sequential elements in a list. Additionally, this function removes -- | Remove sequential elements in a list. Additionally, this function removes
-- the 'head' of the list, because conceptully it is also the 'last'. -- the 'head' of the list, because conceptully it is also the 'last'.
unloop :: Eq a => [[a]] -> [a] unloop :: Eq a => [[a]] -> [a]
unloop = drop 1 . fmap head . group . join unloop = drop 1 . fmap head . group . join
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Insert an element into the middle (not 'head' or 'last') of a list. -- | Insert an element into the middle (not 'head' or 'last') of a list.
insertMiddle :: [a] -> a -> Gen [a] insertMiddle :: [a] -> a -> Gen [a]
@ -142,7 +135,6 @@ insertMiddle as a = do
i <- choose (1, n - 1) i <- choose (1, n - 1)
pure $ insertAt i a as pure $ insertAt i a as
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- | Helper function to insert an element into a list at a given position. -- | Helper function to insert an element into a list at a given position.
-- --