simple-affine-space (empty) → 0.1

raw patch · 12 files changed

+816/−0 lines, 12 filesdep +basedep +deepseqdep +directorysetup-changed

Dependencies added: base, deepseq, directory, filepath, hlint, process, regex-posix

Files

• CHANGELOG +7/−0
• LICENSE +29/−0
• Setup.hs +2/−0
• simple-affine-space.cabal +78/−0
• src/Data/AffineSpace.hs +51/−0
• src/Data/Point2.hs +58/−0
• src/Data/Point3.hs +66/−0
• src/Data/Vector2.hs +106/−0
• src/Data/Vector3.hs +125/−0
• src/Data/VectorSpace.hs +178/−0
• tests/HaddockCoverage.hs +93/−0
• tests/hlint.hs +23/−0

@@ -0,0 +1,7 @@+2018-10-31 Ivan Perez <ivan.perez@keera.co.uk>+        * Added basic travis setup.+        * Added documentation (README), link to Yampa.+        * Version imported from Yampa.++Copyright (c) 2003, Henrik Nilsson, Antony Courtney and Yale University.+All rights reserved.

@@ -0,0 +1,29 @@+Copyright (c) 2003, Henrik Nilsson, Antony Courtney and Yale University.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++- Neither name of the copyright holders nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS+OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR+TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+name: simple-affine-space+version: 0.1+cabal-version: >= 1.8+license: BSD3+license-file: LICENSE+author: Henrik Nilsson, Antony Courtney+maintainer: Ivan Perez (ivan.perez@keera.co.uk)+homepage: http://www.haskell.org/haskellwiki/Yampa+category: Reactivity, FRP+synopsis: A simple library for affine and vector spaces.++description:+  Affine spaces and vector spaces with a few basic instances.+  .+  This library implements affine spaces and vector spaces. Two instances are+  provided for affine spaces (points) and two more for vector spaces (vectors).+  These definitions are strict, implement deepseq, and are designed to have+  minimal memory overhead.++build-type: Simple+extra-source-files:+  CHANGELOG++-- You can disable the hlint test suite with -f-test-hlint+flag test-hlint+  Description: Enable hlint test suite+  default: True+  manual: True++-- You can disable the haddock coverage test suite with -f-test-doc-coverage+flag test-doc-coverage+  Description: Enable haddock coverage test suite+  default: True+  manual: True++library+  hs-source-dirs:  src+  ghc-options : -O3 -Wall -fno-warn-name-shadowing+  build-Depends: base < 5, deepseq+  exposed-modules:+    Data.AffineSpace+    Data.Point2+    Data.Point3+    Data.Vector2+    Data.Vector3+    Data.VectorSpace++test-suite hlint+  type: exitcode-stdio-1.0+  main-is: hlint.hs+  hs-source-dirs: tests+  if !flag(test-hlint)+    buildable: False+  else+    build-depends:+      base,+      hlint >= 1.7++-- Verify that the code is thoroughly documented+test-suite haddock-coverage+  type: exitcode-stdio-1.0+  main-is: HaddockCoverage.hs+  ghc-options: -Wall+  hs-source-dirs: tests++  if !flag(test-doc-coverage)+    buildable: False+  else+    build-depends:+      base >= 4 && < 5,+      directory,+      filepath,+      process,+      regex-posix++source-repository head+  type:     git+  location: git://github.com/ivanperez-keera/simple-affine-space.git

@@ -0,0 +1,51 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  Data.AffineSpace+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- Affine space type relation.+--+-----------------------------------------------------------------------------------------++module Data.AffineSpace where++import Data.VectorSpace++infix 6 .+^, .-^, .-.++-- Maybe origin should not be a class method, even though an origin+-- can be assocoated with any affine space.+-- Maybe distance should not be a class method, in which case the constraint+-- on the coefficient space (a) could be Fractional (i.e., a Field), which+-- seems closer to the mathematical definition of affine space, provided+-- the constraint on the coefficient space for VectorSpace is also Fractional.++-- | Affine Space type relation.+--+-- An affine space is a set (type) @p@, and an associated vector space @v@ over+-- a field @a@.+class (Floating a, VectorSpace v a) => AffineSpace p v a | p -> v, v -> a where++    -- | Origin of the affine space.+    origin   :: p++    -- | Addition of affine point and vector.+    (.+^)    :: p -> v -> p++    -- | Subtraction of affine point and vector.+    (.-^)    :: p -> v -> p+    p .-^ v = p .+^ (negateVector v)++    -- | Subtraction of two points in the affine space, giving a vector.+    (.-.)    :: p -> p -> v++    -- | Distance between two points in the affine space, same as the 'norm' of+    -- the vector they form (see '(.-.)'.+    distance :: p -> p -> a+    distance p1 p2 = norm (p1 .-. p2)

@@ -0,0 +1,58 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  Data.Point2+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- 2D point abstraction (R^2).+--+-----------------------------------------------------------------------------------------++module Data.Point2 (+    Point2(..), -- Non-abstract, instance of AffineSpace+    point2X,    -- :: RealFloat a => Point2 a -> a+    point2Y     -- :: RealFloat a => Point2 a -> a+) where++import Control.DeepSeq (NFData(..))++import Data.VectorSpace ()+import Data.AffineSpace+import Data.Vector2++-- * 2D point, constructors and selectors++-- | 2D point.+data Point2 a = RealFloat a => Point2 !a !a++deriving instance Eq a => Eq (Point2 a)++deriving instance Show a => Show (Point2 a)++instance NFData a => NFData (Point2 a) where+  rnf (Point2 x y) = rnf x `seq` rnf y `seq` ()++-- | X coordinate of a 2D point.+point2X :: RealFloat a => Point2 a -> a+point2X (Point2 x _) = x++-- | Y coordinate of a 2D point.+point2Y :: RealFloat a => Point2 a -> a+point2Y (Point2 _ y) = y++-- * Affine space instance++instance RealFloat a => AffineSpace (Point2 a) (Vector2 a) a where+    origin = Point2 0 0++    (Point2 x y) .+^ v = Point2 (x + vector2X v) (y + vector2Y v)++    (Point2 x y) .-^ v = Point2 (x - vector2X v) (y - vector2Y v)++    (Point2 x1 y1) .-. (Point2 x2 y2) = vector2 (x1 - x2) (y1 - y2)

@@ -0,0 +1,66 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  Data.Point3+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- 3D point abstraction (R^3).+--+-----------------------------------------------------------------------------------------++module Data.Point3 (+    Point3(..), -- Non-abstract, instance of AffineSpace+    point3X,    -- :: RealFloat a => Point3 a -> a+    point3Y,    -- :: RealFloat a => Point3 a -> a+    point3Z     -- :: RealFloat a => Point3 a -> a+) where++import Control.DeepSeq (NFData(..))++import Data.VectorSpace ()+import Data.AffineSpace+import Data.Vector3++-- * 3D point, constructors and selectors++-- | 3D point.+data Point3 a = RealFloat a => Point3 !a !a !a++deriving instance Eq a => Eq (Point3 a)++deriving instance Show a => Show (Point3 a)++instance NFData a => NFData (Point3 a) where+  rnf (Point3 x y z) = rnf x `seq` rnf y `seq` rnf z `seq` ()++-- | X coodinate of a 3D point.+point3X :: RealFloat a => Point3 a -> a+point3X (Point3 x _ _) = x++-- | Y coodinate of a 3D point.+point3Y :: RealFloat a => Point3 a -> a+point3Y (Point3 _ y _) = y++-- | Z coodinate of a 3D point.+point3Z :: RealFloat a => Point3 a -> a+point3Z (Point3 _ _ z) = z++-- * Affine space instance++instance RealFloat a => AffineSpace (Point3 a) (Vector3 a) a where+    origin = Point3 0 0 0++    (Point3 x y z) .+^ v =+        Point3 (x + vector3X v) (y + vector3Y v) (z + vector3Z v)++    (Point3 x y z) .-^ v =+        Point3 (x - vector3X v) (y - vector3Y v) (z - vector3Z v)++    (Point3 x1 y1 z1) .-. (Point3 x2 y2 z2) =+        vector3 (x1 - x2) (y1 - y2) (z1 - z2)

@@ -0,0 +1,106 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  Data.Vector2+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- 2D vector abstraction (R^2).+--+-----------------------------------------------------------------------------------------++module Data.Vector2 (+    Vector2,            -- Abstract, instance of VectorSpace+    vector2,            -- :: RealFloat a => a -> a -> Vector2 a+    vector2X,           -- :: RealFloat a => Vector2 a -> a+    vector2Y,           -- :: RealFloat a => Vector2 a -> a+    vector2XY,          -- :: RealFloat a => Vector2 a -> (a, a)+    vector2Polar,       -- :: RealFloat a => a -> a -> Vector2 a+    vector2Rho,         -- :: RealFloat a => Vector2 a -> a+    vector2Theta,       -- :: RealFloat a => Vector2 a -> a+    vector2RhoTheta,    -- :: RealFloat a => Vector2 a -> (a, a)+    vector2Rotate       -- :: RealFloat a => a -> Vector2 a -> Vector2 a+) where++import Control.DeepSeq (NFData(..))++import Data.VectorSpace++-- * 2D vector, constructors and selectors++-- | 2D Vector.++-- Restrict coefficient space to RealFloat (rather than Floating) for now.+-- While unclear if a complex coefficient space would be useful (and if the+-- result really would be a 2d vector), the only thing causing trouble is the+-- use of atan2 in vector2Theta. Maybe atan2 can be generalized?++data Vector2 a = RealFloat a => Vector2 !a !a++deriving instance Eq a => Eq (Vector2 a)++deriving instance Show a => Show (Vector2 a)++instance NFData a => NFData (Vector2 a) where+  rnf (Vector2 x y) = rnf x `seq` rnf y `seq` ()++-- | Creates a 2D vector from the cartesian coordinates.+vector2 :: RealFloat a => a -> a -> Vector2 a+vector2 = Vector2++-- | X cartesian coordinate.+vector2X :: RealFloat a => Vector2 a -> a+vector2X (Vector2 x _) = x++-- | Y cartesian coordinate.+vector2Y :: RealFloat a => Vector2 a -> a+vector2Y (Vector2 _ y) = y++-- | Returns a vector's cartesian coordinates.+vector2XY :: RealFloat a => Vector2 a -> (a, a)+vector2XY (Vector2 x y) = (x, y)++-- | Creates a 2D vector from the polar coordinates.+vector2Polar :: RealFloat a => a -> a -> Vector2 a+vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta)++-- | Calculates the vector's radial distance (magnitude).+vector2Rho :: RealFloat a => Vector2 a -> a+vector2Rho (Vector2 x y) = sqrt (x * x + y * y)++-- | Calculates the vector's azimuth (angle).+vector2Theta :: RealFloat a => Vector2 a -> a+vector2Theta (Vector2 x y) = atan2 y x++-- | Polar coordinate representation of a 2D vector.+vector2RhoTheta :: RealFloat a => Vector2 a -> (a, a)+vector2RhoTheta v = (vector2Rho v, vector2Theta v)++-- * Vector space instance++instance RealFloat a => VectorSpace (Vector2 a) a where+    zeroVector = Vector2 0 0++    a *^ (Vector2 x y) = Vector2 (a * x) (a * y)++    (Vector2 x y) ^/ a = Vector2 (x / a) (y / a)++    negateVector (Vector2 x y) = (Vector2 (-x) (-y))++    (Vector2 x1 y1) ^+^ (Vector2 x2 y2) = Vector2 (x1 + x2) (y1 + y2)++    (Vector2 x1 y1) ^-^ (Vector2 x2 y2) = Vector2 (x1 - x2) (y1 - y2)++    (Vector2 x1 y1) `dot` (Vector2 x2 y2) = x1 * x2 + y1 * y2+++-- * Additional operations++-- | Rotates a vector with a given angle.+vector2Rotate :: RealFloat a => a -> Vector2 a -> Vector2 a+vector2Rotate theta' v = vector2Polar (vector2Rho v) (vector2Theta v + theta')

@@ -0,0 +1,125 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  Data.Vector3+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- 3D vector abstraction (R^3).+--+-----------------------------------------------------------------------------------------++module Data.Vector3 (+    Vector3,            -- Abstract, instance of VectorSpace+    vector3,            -- :: RealFloat a => a -> a -> a -> Vector3 a+    vector3X,           -- :: RealFloat a => Vector3 a -> a+    vector3Y,           -- :: RealFloat a => Vector3 a -> a+    vector3Z,           -- :: RealFloat a => Vector3 a -> a+    vector3XYZ,         -- :: RealFloat a => Vector3 a -> (a, a, a)+    vector3Spherical,   -- :: RealFloat a => a -> a -> a -> Vector3 a+    vector3Rho,         -- :: RealFloat a => Vector3 a -> a+    vector3Theta,       -- :: RealFloat a => Vector3 a -> a+    vector3Phi,         -- :: RealFloat a => Vector3 a -> a+    vector3RhoThetaPhi, -- :: RealFloat a => Vector3 a -> (a, a, a)+    vector3Rotate       -- :: RealFloat a => a -> a -> Vector3 a -> Vector3 a+) where++import Control.DeepSeq (NFData(..))++import Data.VectorSpace++-- * 3D vector, constructors and selectors++-- | 3D Vector.++-- Restrict coefficient space to RealFloat (rather than Floating) for now.+-- While unclear if a complex coefficient space would be useful (and if the+-- result really would be a 3d vector), the only thing causing trouble is the+-- use of atan2 in vector3Theta and vector3Phi. Maybe atan2 can be generalized?++data Vector3 a = RealFloat a => Vector3 !a !a !a++deriving instance Eq a => Eq (Vector3 a)++deriving instance Show a => Show (Vector3 a)++instance NFData a => NFData (Vector3 a) where+  rnf (Vector3 x y z) = rnf x `seq` rnf y `seq` rnf z `seq` ()++-- | Creates a 3D vector from the cartesian coordinates.+vector3 :: RealFloat a => a -> a -> a -> Vector3 a+vector3 = Vector3++-- | X cartesian coordinate.+vector3X :: RealFloat a => Vector3 a -> a+vector3X (Vector3 x _ _) = x++-- | Y cartesian coordinate.+vector3Y :: RealFloat a => Vector3 a -> a+vector3Y (Vector3 _ y _) = y++-- | Z cartesian coordinate.+vector3Z :: RealFloat a => Vector3 a -> a+vector3Z (Vector3 _ _ z) = z++-- | Returns a vector's cartesian coordinates.+vector3XYZ :: RealFloat a => Vector3 a -> (a, a, a)+vector3XYZ (Vector3 x y z) = (x, y, z)++-- | Creates a 3D vector from the spherical coordinates.+vector3Spherical :: RealFloat a => a -> a -> a -> Vector3 a+vector3Spherical rho theta phi =+    Vector3 (rhoSinPhi * cos theta) (rhoSinPhi * sin theta) (rho * cos phi)+    where+        rhoSinPhi = rho * sin phi++-- | Calculates the vector's radial distance.+vector3Rho :: RealFloat a => Vector3 a -> a+vector3Rho (Vector3 x y z) = sqrt (x * x + y * y + z * z)++-- | Calculates the vector's azimuth.+vector3Theta :: RealFloat a => Vector3 a -> a+vector3Theta (Vector3 x y _) = atan2 y x++-- | Calculates the vector's inclination.+vector3Phi :: RealFloat a => Vector3 a -> a+vector3Phi v@(Vector3 _ _ z) = acos (z / vector3Rho v)++-- | Spherical coordinate representation of a 3D vector.+vector3RhoThetaPhi :: RealFloat a => Vector3 a -> (a, a, a)+vector3RhoThetaPhi (Vector3 x y z) = (rho, theta, phi)+    where+        rho   = sqrt (x * x + y * y + z * z)+        theta = atan2 y x+        phi   = acos (z / rho)++-- * Vector space instance++instance RealFloat a => VectorSpace (Vector3 a) a where+    zeroVector = Vector3 0 0 0++    a *^ (Vector3 x y z) = Vector3 (a * x) (a * y) (a * z)++    (Vector3 x y z) ^/ a = Vector3 (x / a) (y / a) (z / a)++    negateVector (Vector3 x y z) = (Vector3 (-x) (-y) (-z))++    (Vector3 x1 y1 z1) ^+^ (Vector3 x2 y2 z2) = Vector3 (x1+x2) (y1+y2) (z1+z2)++    (Vector3 x1 y1 z1) ^-^ (Vector3 x2 y2 z2) = Vector3 (x1-x2) (y1-y2) (z1-z2)++    (Vector3 x1 y1 z1) `dot` (Vector3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2++-- * Additional operations++-- | Rotates a vector with a given polar and azimuthal angles.+vector3Rotate :: RealFloat a => a -> a -> Vector3 a -> Vector3 a+vector3Rotate theta' phi' v =+    vector3Spherical (vector3Rho v)+                     (vector3Theta v + theta')+                     (vector3Phi v + phi')

@@ -0,0 +1,178 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  Data.VectorSpace+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- Vector space type relation and basic instances.+-----------------------------------------------------------------------------------------++module Data.VectorSpace where++infixr *^+infixl ^/+infix 7 `dot`+infixl 6 ^+^, ^-^++-- Maybe norm and normalize should not be class methods, in which case+-- the constraint on the coefficient space (a) should (or, at least, could)+-- be Fractional (roughly a Field) rather than Floating.++-- | Vector space type relation.+--+--   A vector space is a set (type) closed under addition and multiplication by+--   a scalar. The type of the scalar is the /field/ of the vector space, and+--   it is said that @v@ is a vector space over @a@.+--+--   The encoding uses a type class |VectorSpace| @v a@, where @v@ represents+--   the type of the vectors and @a@ represents the types of the scalars.++class (Eq a, Floating a) => VectorSpace v a | v -> a where+    -- | Vector with no magnitude (unit for addition).+    zeroVector :: v++    -- | Multiplication by a scalar.+    (*^) :: a -> v -> v++    -- | Division by a scalar.+    (^/) :: v -> a -> v+    v ^/ a = (1/a) *^ v++    -- | Vector addition+    (^+^) :: v -> v -> v++    -- | Vector subtraction+    (^-^) :: v -> v -> v+    v1 ^-^ v2 = v1 ^+^ negateVector v2++    -- | Vector negation. Addition with a negated vector should be+    --   same as subtraction.+    negateVector :: v -> v+    negateVector v = (-1) *^ v++    -- | Dot product (also known as scalar or inner product).+    --+    -- For two vectors, mathematically represented as @a = a1,a2,...,an@ and @b+    -- = b1,b2,...,bn@, the dot product is @a . b = a1*b1 + a2*b2 + ... ++    -- an*bn@.+    --+    -- Some properties are derived from this. The dot product of a vector with+    -- itself is the square of its magnitude ('norm'), and the dot product of+    -- two orthogonal vectors is zero.+    dot :: v -> v -> a++    -- | Vector's norm (also known as magnitude).+    --+    -- For a vector represented mathematically as @a = a1,a2,...,an@, the norm+    -- is the square root of @a1^2 + a2^2 + ... + an^2@.+    norm :: v -> a+    norm v = sqrt (v `dot` v)++    -- | Return a vector with the same origin and orientation (angle), but such+    -- that the norm is one (the unit for multiplication by a scalar).+    normalize    :: v -> v+    normalize v = if nv /= 0 then v ^/ nv else error "normalize: zero vector"+        where nv = norm v++-- | Vector space instance for 'Float's, with 'Float' scalars.+instance VectorSpace Float Float where+    zeroVector = 0++    a *^ x = a * x++    x ^/ a = x / a++    negateVector x = (-x)++    x1 ^+^ x2 = x1 + x2++    x1 ^-^ x2 = x1 - x2++    x1 `dot` x2 = x1 * x2++-- | Vector space instance for 'Double's, with 'Double' scalars.+instance VectorSpace Double Double where+    zeroVector = 0++    a *^ x = a * x++    x ^/ a = x / a++    negateVector x = (-x)++    x1 ^+^ x2 = x1 + x2++    x1 ^-^ x2 = x1 - x2++    x1 `dot` x2 = x1 * x2+++-- | Vector space instance for pairs of 'Floating' point numbers.+instance (Eq a, Floating a) => VectorSpace (a,a) a where+    zeroVector = (0,0)++    a *^ (x,y) = (a * x, a * y)++    (x,y) ^/ a = (x / a, y / a)++    negateVector (x,y) = (-x, -y)++    (x1,y1) ^+^ (x2,y2) = (x1 + x2, y1 + y2)++    (x1,y1) ^-^ (x2,y2) = (x1 - x2, y1 - y2)++    (x1,y1) `dot` (x2,y2) = x1 * x2 + y1 * y2++-- | Vector space instance for triplets of 'Floating' point numbers.+instance (Eq a, Floating a) => VectorSpace (a,a,a) a where+    zeroVector = (0,0,0)++    a *^ (x,y,z) = (a * x, a * y, a * z)++    (x,y,z) ^/ a = (x / a, y / a, z / a)++    negateVector (x,y,z) = (-x, -y, -z)++    (x1,y1,z1) ^+^ (x2,y2,z2) = (x1+x2, y1+y2, z1+z2)++    (x1,y1,z1) ^-^ (x2,y2,z2) = (x1-x2, y1-y2, z1-z2)++    (x1,y1,z1) `dot` (x2,y2,z2) = x1 * x2 + y1 * y2 + z1 * z2++-- | Vector space instance for tuples with four 'Floating' point numbers.+instance (Eq a, Floating a) => VectorSpace (a,a,a,a) a where+    zeroVector = (0,0,0,0)++    a *^ (x,y,z,u) = (a * x, a * y, a * z, a * u)++    (x,y,z,u) ^/ a = (x / a, y / a, z / a, u / a)++    negateVector (x,y,z,u) = (-x, -y, -z, -u)++    (x1,y1,z1,u1) ^+^ (x2,y2,z2,u2) = (x1+x2, y1+y2, z1+z2, u1+u2)++    (x1,y1,z1,u1) ^-^ (x2,y2,z2,u2) = (x1-x2, y1-y2, z1-z2, u1-u2)++    (x1,y1,z1,u1) `dot` (x2,y2,z2,u2) = x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2++-- | Vector space instance for tuples with five 'Floating' point numbers.+instance (Eq a, Floating a) => VectorSpace (a,a,a,a,a) a where+    zeroVector = (0,0,0,0,0)++    a *^ (x,y,z,u,v) = (a * x, a * y, a * z, a * u, a * v)++    (x,y,z,u,v) ^/ a = (x / a, y / a, z / a, u / a, v / a)++    negateVector (x,y,z,u,v) = (-x, -y, -z, -u, -v)++    (x1,y1,z1,u1,v1) ^+^ (x2,y2,z2,u2,v2) = (x1+x2, y1+y2, z1+z2, u1+u2, v1+v2)++    (x1,y1,z1,u1,v1) ^-^ (x2,y2,z2,u2,v2) = (x1-x2, y1-y2, z1-z2, u1-u2, v1-v2)++    (x1,y1,z1,u1,v1) `dot` (x2,y2,z2,u2,v2) =+        x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2 + v1 * v2

@@ -0,0 +1,93 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (HaddockCoverage)+-- Copyright   :  (C) 2015 Ivan Perez+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Ivan Perez <ivan.perez@keera.co.uk>+-- Stability   :  provisional+-- Portability :  portable+--+-- Copyright notice: This file borrows code+-- https://hackage.haskell.org/package/lens-4.7/src/tests/doctests.hsc+-- which is itself licensed BSD-style as well.+--+-- Run haddock on a source tree and report if anything in any+-- module is not documented.+-----------------------------------------------------------------------------+module Main where++import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.Exit+import System.FilePath+import System.IO+import System.Process+import Text.Regex.Posix++main :: IO ()+main = do+  -- Find haskell modules+  -- TODO: Ideally cabal should do this (provide us with the+  -- list of modules). An alternative would be to use cabal haddock+  -- but that would need a --no-html argument or something like that.+  -- Alternatively, we could use cabal haddock with additional arguments.+  --+  -- See:+  -- https://github.com/keera-studios/haddock/commit/d5d752943c4e5c6c9ffcdde4dc136fcee967c495+  -- https://github.com/haskell/haddock/issues/309#issuecomment-150811929+  files <- getSources++  let haddockArgs = [ "--no-warnings" ] ++ files+  let cabalArgs   = [ "exec", "--", "haddock" ] ++ haddockArgs+  print cabalArgs+  (code, out, _err) <- readProcessWithExitCode "cabal" cabalArgs ""++  -- Filter out coverage lines, and find those that denote undocumented+  -- modules.+  --+  -- TODO: is there a way to annotate a function as self-documenting,+  -- in the same way we do with ANN for hlint?+  let isIncompleteModule :: String -> Bool+      isIncompleteModule line = isCoverageLine line && not (line =~ "^ *100%")+        where isCoverageLine :: String -> Bool+              isCoverageLine line = line =~ "^ *[0-9]+%"++  let incompleteModules :: [String]+      incompleteModules = filter isIncompleteModule $ lines out++  -- Based on the result of haddock, report errors and exit.+  -- Note that, unline haddock, this script does not+  -- output anything to stdout. It uses stderr instead+  -- (as it should).+  case (code, incompleteModules) of+    (ExitSuccess  , []) -> return ()+    (ExitFailure _, _)  -> exitFailure+    (_            , _)  -> do+      hPutStrLn stderr "The following modules are not fully documented:"+      mapM_ (hPutStrLn stderr) incompleteModules+      exitFailure++getSources :: IO [FilePath]+getSources = filter isHaskellFile <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++    isHaskellFile fp = (isSuffixOf ".hs" fp || isSuffixOf ".lhs" fp)+                     && not (any (`isSuffixOf` fp) excludedFiles)++    excludedFiles = [ "Vector2.hs", "Vector3.hs"+                    , "Point2.hs", "Point3.hs" ]++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c++-- find-based implementation (not portable)+--+-- getSources :: IO [FilePath]+-- getSources = fmap lines $ readProcess "find" ["src/", "-iname", "*hs"] ""

@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (hlint)+-- Copyright   :  (C) 2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module runs HLint on the lens source tree.+-----------------------------------------------------------------------------+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Environment+import System.Exit++main :: IO ()+main = do+    args <- getArgs+    hints <- hlint $ ["src", "--cross"] ++ args+    unless (null hints) exitFailure