linear 0.4.2.2 → 0.5
raw patch · 21 files changed
+555/−80 lines, 21 filesbuild-type:Customsetup-changed
Files
- .gitignore +8/−0
- .travis.yml +19/−6
- CHANGELOG.markdown +4/−0
- LICENSE +1/−1
- Setup.lhs +41/−4
- config +0/−16
- linear.cabal +8/−7
- src/Linear.hs +35/−12
- src/Linear/Conjugate.hs +12/−0
- src/Linear/Epsilon.hs +1/−0
- src/Linear/Matrix.hs +12/−0
- src/Linear/Metric.hs +12/−0
- src/Linear/Plucker.hs +66/−0
- src/Linear/Quaternion.hs +95/−29
- src/Linear/V2.hs +62/−0
- src/Linear/V3.hs +67/−0
- src/Linear/V4.hs +73/−0
- src/Linear/Vector.hs +1/−1
- tests/doctests.hs +6/−4
- travis/cabal-apt-install +16/−0
- travis/config +16/−0
.gitignore view
@@ -3,3 +3,11 @@ wiki TAGS tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#
.travis.yml view
@@ -1,15 +1,28 @@ language: haskell--# Uncomment the next 4 lines whenever hackage is down. before_install:- - mkdir -p ~/.cabal- - cp config ~/.cabal/config- - cabal update+ # Uncomment whenever hackage is down.+ # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update + # Try installing some of the build-deps with apt-get for speed.+ - travis/cabal-apt-install --only-dependencies --force-reinstall $mode++ - sudo apt-get -q -y install hlint || cabal install hlint++install:+ - cabal configure $mode+ - cabal build++script:+ - $script+ - hlint src --cpp-define HLINT+ notifications: irc: channels:- - "irc.freenode.org#edwardk"+ - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313linear\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+ - mode="--enable-tests" script="cabal test"
CHANGELOG.markdown view
@@ -1,3 +1,7 @@+0.5+-------+* Added `Ix` instances for `V2`, `V3`, and `V4`+ 0.4.2.2 ------- * Removed the upper bound on `distributive`
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-12 Edward Kmett+Copyright 2011-13 Edward Kmett All rights reserved.
Setup.lhs view
@@ -1,7 +1,44 @@ #!/usr/bin/runhaskell-> module Main (main) where+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where -> import Distribution.Simple+import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+import System.FilePath ( (</>) ) -> main :: IO ()-> main = defaultMain+main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+ buildHook simpleUserHooks pkg lbi hooks flags+ }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+ let dir = autogenModulesDir lbi+ createDirectoryIfMissingVerbose verbosity True dir+ withLibLBI pkg lbi $ \_ libcfg -> do+ withTestLBI pkg lbi $ \suite suitecfg -> do+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+ [ "module Build_" ++ testName suite ++ " where"+ , "deps :: [String]"+ , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+ ]+ where+ formatdeps = map (formatone . snd)+ formatone p = case packageName p of+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
− config
@@ -1,16 +0,0 @@--- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix------ This is particularly useful for travis-ci to get it to stop complaining--- about a broken build when everything is still correct on our end.------ This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead------ To enable this, uncomment the before_script in .travis.yml--remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive-remote-repo-cache: ~/.cabal/packages-world-file: ~/.cabal/world-build-summary: ~/.cabal/logs/build.log-remote-build-reporting: anonymous-install-dirs user-install-dirs global
linear.cabal view
@@ -1,6 +1,6 @@ name: linear category: Math, Algebra-version: 0.4.2.2+version: 0.5 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -9,19 +9,20 @@ stability: provisional homepage: http://github.com/ekmett/linear/ bug-reports: http://github.com/ekmett/linear/issues-copyright: Copyright (C) 2012 Edward A. Kmett+copyright: Copyright (C) 2012-2013 Edward A. Kmett synopsis: Linear Algebra description: Types and combinators for low-dimension-count linear algebra on free vector spaces-build-type: Simple-tested-with: GHC == 7.4.2, GHC == 7.6.1+build-type: Custom+tested-with: GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1 extra-source-files:- .travis.yml .ghci .gitignore+ .travis.yml .vim.custom- config- README.markdown+ travis/cabal-apt-install+ travis/config CHANGELOG.markdown+ README.markdown source-repository head type: git
src/Linear.hs view
@@ -1,13 +1,36 @@--- |This module simply re-exports everything from the various modules+-----------------------------------------------------------------------------+-- |+-- Module : Linear+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- This module simply re-exports everything from the various modules -- that make up the linear package.-module Linear (module X) where-import Linear.Conjugate as X-import Linear.Epsilon as X-import Linear.Matrix as X-import Linear.Metric as X-import Linear.Plucker as X-import Linear.Quaternion as X-import Linear.V2 as X-import Linear.V3 as X-import Linear.V4 as X-import Linear.Vector as X+----------------------------------------------------------------------------+module Linear+ ( module Linear.Conjugate+ , module Linear.Epsilon+ , module Linear.Matrix+ , module Linear.Metric+ , module Linear.Plucker+ , module Linear.Quaternion+ , module Linear.V2+ , module Linear.V3+ , module Linear.V4+ , module Linear.Vector+ ) where++import Linear.Conjugate+import Linear.Epsilon+import Linear.Matrix+import Linear.Metric+import Linear.Plucker+import Linear.Quaternion+import Linear.V2+import Linear.V3+import Linear.V4+import Linear.Vector
src/Linear/Conjugate.hs view
@@ -1,3 +1,15 @@+-----------------------------------------------------------------------------+-- |+-- Module : Linear.Conjugate+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Involutive rings+---------------------------------------------------------------------------- module Linear.Conjugate ( Conjugate(..) ) where
src/Linear/Epsilon.hs view
@@ -7,6 +7,7 @@ -- Stability : provisional -- Portability : portable --+-- Testing for values "near" zero ----------------------------------------------------------------------------- module Linear.Epsilon ( Epsilon(..)
src/Linear/Matrix.hs view
@@ -1,3 +1,15 @@+-----------------------------------------------------------------------------+-- |+-- Module : Linear.Matrix+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Simple matrix operation for low-dimensional primitives.+---------------------------------------------------------------------------- module Linear.Matrix ( (!*!), (!*) , (*!), (!!*), (*!!) , adjoint
src/Linear/Metric.hs view
@@ -1,3 +1,15 @@+-----------------------------------------------------------------------------+-- |+-- Module : Linear.Metric+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Free metric spaces+---------------------------------------------------------------------------- module Linear.Metric ( Metric(..), normalize ) where
src/Linear/Plucker.hs view
@@ -1,3 +1,15 @@+-----------------------------------------------------------------------------+-- |+-- Module : Linear.Plucker+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Plücker coordinates for lines in 3d homogeneous space.+---------------------------------------------------------------------------- module Linear.Plucker ( Plucker(..) , squaredError@@ -13,6 +25,7 @@ import Data.Monoid import Data.Traversable import Linear.Epsilon+import GHC.Arr (Ix(..)) import Linear.Metric import Control.Lens import Linear.V4@@ -22,42 +35,88 @@ instance Functor Plucker where fmap g (Plucker a b c d e f) = Plucker (g a) (g b) (g c) (g d) (g e) (g f)+ {-# INLINE fmap #-} instance Applicative Plucker where pure a = Plucker a a a a a a+ {-# INLINE pure #-} Plucker a b c d e f <*> Plucker g h i j k l = Plucker (a g) (b h) (c i) (d j) (e k) (f l)+ {-# INLINE (<*>) #-} instance Monad Plucker where return a = Plucker a a a a a a+ {-# INLINE return #-} (>>=) = bindRep+ {-# INLINE (>>=) #-} instance Distributive Plucker where distribute = distributeRep+ {-# INLINE distribute #-} instance Representable Plucker where rep f = Plucker (f p01) (f p02) (f p03) (f p23) (f p31) (f p12)+ {-# INLINE rep #-} instance Foldable Plucker where foldMap g (Plucker a b c d e f) = g a `mappend` g b `mappend` g c `mappend` g d `mappend` g e `mappend` g f+ {-# INLINE foldMap #-} instance Traversable Plucker where traverse g (Plucker a b c d e f) = Plucker <$> g a <*> g b <*> g c <*> g d <*> g e <*> g f+ {-# INLINE traverse #-} +instance Ix a => Ix (Plucker a) where+ range (Plucker l1 l2 l3 l4 l5 l6,Plucker u1 u2 u3 u4 u5 u6) =+ [Plucker i1 i2 i3 i4 i5 i6 | i1 <- range (l1,u1)+ , i2 <- range (l2,u2)+ , i3 <- range (l3,u3)+ , i4 <- range (l4,u4)+ , i5 <- range (l5,u5)+ , i6 <- range (l6,u6)+ ]+ {-# INLINE range #-}++ unsafeIndex (Plucker l1 l2 l3 l4 l5 l6,Plucker u1 u2 u3 u4 u5 u6) (Plucker i1 i2 i3 i4 i5 i6) =+ unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * (+ unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (+ unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+ unsafeIndex (l1,u1) i1)))))+ {-# INLINE unsafeIndex #-}++ inRange (Plucker l1 l2 l3 l4 l5 l6,Plucker u1 u2 u3 u4 u5 u6) (Plucker i1 i2 i3 i4 i5 i6) =+ inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+ inRange (l3,u3) i3 && inRange (l4,u4) i4 &&+ inRange (l5,u5) i5 && inRange (l6,u6) i6+ {-# INLINE inRange #-}+ instance Num a => Num (Plucker a) where (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-} (*) = liftA2 (*)+ {-# INLINE (*) #-} negate = fmap negate+ {-# INLINE negate #-} abs = fmap abs+ {-# INLINE abs #-} signum = fmap signum+ {-# INLINE signum #-} fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-} instance Fractional a => Fractional (Plucker a) where recip = fmap recip+ {-# INLINE recip #-} (/) = liftA2 (/)+ {-# INLINE (/) #-} fromRational = pure . fromRational+ {-# INLINE fromRational #-} -- | Given a pair of points represented by homogeneous coordinates generate Plücker coordinates -- for the line through them.@@ -70,6 +129,7 @@ (c*h-d*g) (d*f-b*h) (b*g-c*f)+{-# INLINE plucker #-} -- | These elements form a basis for the Plücker space, or the Grassmanian manifold @Gr(2,V4)@. p01, p02, p03, p23, p31, p12 :: Functor f => (a -> f a) -> Plucker a -> f (Plucker a)@@ -91,24 +151,30 @@ -- That said, floating point makes a mockery of this claim, so you may want to use 'nearZero'. squaredError :: (Eq a, Num a) => Plucker a -> a squaredError v = v >< v+{-# INLINE squaredError #-} -- | This isn't th actual metric because this bilinear form gives rise to an isotropic quadratic space infixl 5 >< (><) :: Num a => Plucker a -> Plucker a -> a Plucker a b c d e f >< Plucker g h i j k l = a*g+b*h+c*i-d*j-e*k-f*l+{-# INLINE (><) #-} -- | Checks if the line is near-isotropic (isotropic vectors in this quadratic space represent lines in real 3d space) isotropic :: Epsilon a => Plucker a -> Bool isotropic a = nearZero (a >< a)+{-# INLINE isotropic #-} -- | Checks if the two vectors intersect (or nearly intersect) intersects :: Epsilon a => Plucker a -> Plucker a -> Bool intersects a b = nearZero (a >< b)+{-# INLINE intersects #-} instance Metric Plucker where dot (Plucker a b c d e f) (Plucker g h i j k l) = a*g+b*h+c*i+d*j+e*k+f*l+ {-# INLINE dot #-} instance Epsilon a => Epsilon (Plucker a) where nearZero = nearZero . quadrance+ {-# INLINE nearZero #-} -- TODO: drag some more stuff out of my thesis
src/Linear/Quaternion.hs view
@@ -1,4 +1,16 @@ {-# LANGUAGE DeriveDataTypeable, PatternGuards, ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Linear.Quaternion+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Quaternions+---------------------------------------------------------------------------- module Linear.Quaternion ( Quaternion(..) , Complicated(..)@@ -21,6 +33,7 @@ import Data.Data import Data.Distributive import Data.Foldable+import GHC.Arr (Ix(..)) import qualified Data.Foldable as F import Data.Monoid import Foreign.Ptr (castPtr, plusPtr)@@ -37,46 +50,81 @@ instance Functor Quaternion where fmap f (Quaternion e v) = Quaternion (f e) (fmap f v)+ {-# INLINE fmap #-} a <$ _ = Quaternion a (V3 a a a)+ {-# INLINE (<$) #-} instance Applicative Quaternion where pure a = Quaternion a (pure a)+ {-# INLINE pure #-} Quaternion f fv <*> Quaternion a v = Quaternion (f a) (fv <*> v)+ {-# INLINE (<*>) #-} instance Monad Quaternion where return = pure+ {-# INLINE return #-} (>>=) = bindRep -- the diagonal of a sedenion is super useful!+ {-# INLINE (>>=) #-} +instance Ix a => Ix (Quaternion a) where+ {-# SPECIALISE instance Ix (Quaternion Int) #-}++ range (Quaternion l1 l2, Quaternion u1 u2) =+ [ Quaternion i1 i2 | i1 <- range (l1,u1), i2 <- range (l2,u2) ]+ {-# INLINE range #-}++ unsafeIndex (Quaternion l1 l2, Quaternion u1 u2) (Quaternion i1 i2) =+ unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2+ {-# INLINE unsafeIndex #-}++ inRange (Quaternion l1 l2, Quaternion u1 u2) (Quaternion i1 i2) =+ inRange (l1,u1) i1 && inRange (l2,u2) i2+ {-# INLINE inRange #-}+ instance Representable Quaternion where rep f = Quaternion (f _e) (V3 (f _i) (f _j) (f _k))+ {-# INLINE rep #-} instance Foldable Quaternion where foldMap f (Quaternion e v) = f e `mappend` foldMap f v+ {-# INLINE foldMap #-} foldr f z (Quaternion e v) = f e (F.foldr f z v)+ {-# INLINE foldr #-} instance Traversable Quaternion where traverse f (Quaternion e v) = Quaternion <$> f e <*> traverse f v+ {-# INLINE traverse #-} instance forall a. Storable a => Storable (Quaternion a) where sizeOf _ = 4 * sizeOf (undefined::a)+ {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)+ {-# INLINE alignment #-} poke ptr (Quaternion e v) = poke (castPtr ptr) e >> poke (castPtr (ptr `plusPtr` sz)) v where sz = sizeOf (undefined::a)+ {-# INLINE poke #-} peek ptr = Quaternion <$> peek (castPtr ptr) <*> peek (castPtr (ptr `plusPtr` sz)) where sz = sizeOf (undefined::a)+ {-# INLINE peek #-} instance RealFloat a => Num (Quaternion a) where {-# SPECIALIZE instance Num (Quaternion Float) #-} {-# SPECIALIZE instance Num (Quaternion Double) #-} (+) = liftA2 (+)+ {-# INLINE (+) #-} (-) = liftA2 (-)+ {-# INLINE (-) #-} negate = fmap negate+ {-# INLINE negate #-} Quaternion s1 v1 * Quaternion s2 v2 = Quaternion (s1*s2 - (v1 `dot` v2)) $ (v1 `cross` v2) + s1*^v2 + s2*^v1+ {-# INLINE (*) #-} fromInteger x = Quaternion (fromInteger x) 0+ {-# INLINE fromInteger #-} abs z = Quaternion (norm z) 0+ {-# INLINE abs #-} signum q@(Quaternion e (V3 i j k)) | m == 0.0 = q | not (isInfinite m || isNaN m) = q ^/ sqrt m@@ -92,12 +140,11 @@ ii = isInfinite i ij = isInfinite j ik = isInfinite k-- -- abs = error "Quaternion.abs: use norm"- -- signum = error "Quaternion.signum: use signorm"+ {-# INLINE signum #-} qNaN :: RealFloat a => Quaternion a qNaN = Quaternion fNaN (V3 fNaN fNaN fNaN) where fNaN = 0/0+{-# INLINE qNaN #-} -- {-# RULES "abs/norm" abs x = Quaternion (norm x) 0 #-} -- {-# RULES "signum/signorm" signum = signorm #-}@@ -113,11 +160,15 @@ (r0*q2+r1*q3-r2*q0-r3*q1) (r0*q3-r1*q2+r2*q1-r3*q0)) ^/ (r0*r0 + r1*r1 + r2*r2 + r3*r3)+ {-# INLINE (/) #-} recip q = q ^/ quadrance q+ {-# INLINE recip #-} fromRational x = Quaternion (fromRational x) 0+ {-# INLINE fromRational #-} instance Metric Quaternion where Quaternion e v `dot` Quaternion e' v' = e*e' + (v `dot` v')+ {-# INLINE dot #-} class Complicated t where _e :: Functor f => (a -> f a) -> t a -> f (t a)@@ -125,12 +176,15 @@ instance Complicated Complex where _e f (a :+ b) = (:+ b) <$> f a+ {-# INLINE _e #-} _i f (a :+ b) = (a :+) <$> f b+ {-# INLINE _i #-} instance Complicated Quaternion where _e f (Quaternion a v) = (\a' -> Quaternion a' v) <$> f a+ {-# INLINE _e #-} _i f (Quaternion a v) = Quaternion a <$> _x f v- --_i f (Quaternion a (V3 b c d)) = (\b' -> Quaternion a (V3 b' c d)) <$> f b+ {-# INLINE _i #-} class Complicated t => Hamiltonian t where _j :: Functor f => (a -> f a) -> t a -> f (t a)@@ -139,17 +193,19 @@ instance Hamiltonian Quaternion where _j f (Quaternion a v) = Quaternion a <$> _y f v+ {-# INLINE _j #-} _k f (Quaternion a v) = Quaternion a <$> _z f v- -- _j f (Quaternion a (V3 b c d)) = (\c' -> Quaternion a (V3 b c' d)) <$> f c- -- _k f (Quaternion a (V3 b c d)) = Quaternion a . V3 b c <$> f d-+ {-# INLINE _k #-} _ijk f (Quaternion a v) = Quaternion a <$> f v+ {-# INLINE _ijk #-} instance Distributive Quaternion where distribute = distributeRep+ {-# INLINE distribute #-} instance (Conjugate a, RealFloat a) => Conjugate (Quaternion a) where conjugate (Quaternion e v) = Quaternion (conjugate e) (negate v)+ {-# INLINE conjugate #-} reimagine :: RealFloat a => a -> a -> Quaternion a -> Quaternion a reimagine r s (Quaternion _ v)@@ -157,35 +213,43 @@ aux x = s * x in Quaternion r (aux <$> v) | otherwise = Quaternion r (v^*s)+{-# INLINE reimagine #-} -- | quadrance of the imaginary component qi :: Num a => Quaternion a -> a qi (Quaternion _ v) = quadrance v+{-# INLINE qi #-} -- | norm of the imaginary component absi :: Floating a => Quaternion a -> a absi = sqrt . qi+{-# INLINE absi #-} -- | raise a 'Quaternion' to a scalar power pow :: RealFloat a => Quaternion a -> a -> Quaternion a pow q t = exp (t *^ log q)+{-# INLINE pow #-} -- ehh.. instance RealFloat a => Floating (Quaternion a) where {-# SPECIALIZE instance Floating (Quaternion Float) #-} {-# SPECIALIZE instance Floating (Quaternion Double) #-} pi = Quaternion pi 0+ {-# INLINE pi #-} exp q@(Quaternion e v) | qiq == 0 = Quaternion (exp e) v | ai <- sqrt qiq, ee <- exp e = reimagine (ee * cos ai) (ee * (sin ai / ai)) q where qiq = qi q+ {-# INLINE exp #-} log q@(Quaternion e v@(V3 _i j k)) | qiq == 0 = if e >= 0 then Quaternion (log e) v else Quaternion (log (negate e)) (V3 pi j k) -- mmm, pi | ai <- sqrt qiq, m <- sqrt (e*e + qiq) = reimagine (log m) (atan2 m e / ai) q where qiq = qi q+ {-# INLINE log #-} x ** y = exp (y * log x)+ {-# INLINE (**) #-} sqrt q@(Quaternion e v) | m == 0 = q | qiq == 0 = if e > 0@@ -194,41 +258,55 @@ | im <- sqrt (0.5*(m-e)) / sqrt qiq = Quaternion (0.5*(m+e)) (v^*im) where qiq = qi q m = sqrt (e*e + qiq)+ {-# INLINE sqrt #-} cos q@(Quaternion e v) | qiq == 0 = Quaternion (cos e) v | ai <- sqrt qiq = reimagine (cos e * cosh ai) (- sin e * (sinh ai / ai)) q where qiq = qi q+ {-# INLINE cos #-} sin q@(Quaternion e v) | qiq == 0 = Quaternion (sin e) v | ai <- sqrt qiq = reimagine (sin e * cosh ai) (cos e * (sinh ai / ai)) q where qiq = qi q+ {-# INLINE sin #-} tan q@(Quaternion e v) | qiq == 0 = Quaternion (tan e) v | ai <- sqrt qiq, ce <- cos e, sai <- sinh ai, d <- ce*ce + sai*sai = reimagine (ce * sin e / d) (cosh ai * (sai / ai) / d) q where qiq = qi q+ {-# INLINE tan #-} sinh q@(Quaternion e v) | qiq == 0 = Quaternion (sinh e) v | ai <- sqrt qiq = reimagine (sinh e * cos ai) (cosh e * (sin ai / ai)) q where qiq = qi q+ {-# INLINE sinh #-} cosh q@(Quaternion e v) | qiq == 0 = Quaternion (cosh e) v | ai <- sqrt qiq = reimagine (cosh e * cos ai) ((sinh e * sin ai) / ai) q where qiq = qi q+ {-# INLINE cosh #-} tanh q@(Quaternion e v) | qiq == 0 = Quaternion (tanh e) v | ai <- sqrt qiq, se <- sinh e, cai <- cos ai, d <- se*se + cai*cai = reimagine ((cosh e * se) / d) ((cai * (sin ai / ai)) / d) q where qiq = qi q+ {-# INLINE tanh #-} asin q = cut asin q+ {-# INLINE asin #-} acos q = cut acos q+ {-# INLINE acos #-} atan q = cut atan q+ {-# INLINE atan #-} asinh q = cut asinh q+ {-# INLINE asinh #-} acosh q = cut acosh q+ {-# INLINE acosh #-} atanh q = cut atanh q+ {-# INLINE atanh #-} + -- | Helper for calculating with specific branch cuts cut :: RealFloat a => (Complex a -> Complex a) -> Quaternion a -> Quaternion a cut f q@(Quaternion e v)@@ -237,6 +315,7 @@ where qiq = qi q ai = sqrt qiq a :+ b = f (e :+ ai)+{-# INLINE cut #-} -- | Helper for calculating with specific branch cuts cutWith :: RealFloat a => Complex a -> Quaternion a -> Quaternion a@@ -244,6 +323,7 @@ | e /= 0 || qiq == 0 || isNaN qiq || isInfinite qiq = error "bad cut" | s <- im / sqrt qiq = Quaternion r (v^*s) where qiq = qi q+{-# INLINE cutWith #-} -- | 'asin' with a specified branch cut. asinq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a@@ -251,6 +331,7 @@ | qiq /= 0.0 || e >= -1 && e <= 1 = asin q | otherwise = cutWith (asin (e :+ sqrt qiq)) u where qiq = qi q+{-# INLINE asinq #-} -- | 'acos' with a specified branch cut. acosq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a@@ -258,6 +339,7 @@ | qiq /= 0.0 || e >= -1 && e <= 1 = acos q | otherwise = cutWith (acos (e :+ sqrt qiq)) u where qiq = qi q+{-# INLINE acosq #-} -- | 'atan' with a specified branch cut. atanq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a@@ -265,6 +347,7 @@ | e /= 0.0 || qiq >= -1 && qiq <= 1 = atan q | otherwise = cutWith (atan (e :+ sqrt qiq)) u where qiq = qi q+{-# INLINE atanq #-} -- | 'asinh' with a specified branch cut. asinhq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a@@ -272,6 +355,7 @@ | e /= 0.0 || qiq >= -1 && qiq <= 1 = asinh q | otherwise = cutWith (asinh (e :+ sqrt qiq)) u where qiq = qi q+{-# INLINE asinhq #-} -- | 'acosh' with a specified branch cut. acoshq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a@@ -279,6 +363,7 @@ | qiq /= 0.0 || e >= 1 = asinh q | otherwise = cutWith (acosh (e :+ sqrt qiq)) u where qiq = qi q+{-# INLINE acoshq #-} -- | 'atanh' with a specified branch cut. atanhq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a@@ -286,6 +371,7 @@ | qiq /= 0.0 || e > -1 && e < 1 = atanh q | otherwise = cutWith (atanh (e :+ sqrt qiq)) u where qiq = qi q+{-# INLINE atanhq #-} -- | Spherical linear interpolation between two quaternions. slerp :: RealFloat a => Quaternion a -> Quaternion a -> a -> Quaternion a@@ -299,39 +385,19 @@ {-# SPECIALIZE slerp :: Quaternion Float -> Quaternion Float -> Float -> Quaternion Float #-} {-# SPECIALIZE slerp :: Quaternion Double -> Quaternion Double -> Double -> Quaternion Double #-} ---slerp :: RealFloat a => Quaternion a -> Quaternion a -> a -> Quaternion a---slerp q0 q1 = let q10 = q1 / q0 in \t -> pow q10 t * q0- -- | Apply a rotation to a vector. rotate :: (Conjugate a, RealFloat a) => Quaternion a -> V3 a -> V3 a rotate q v = (q * Quaternion 0 v * conjugate q)^._ijk--{--rotate :: Num a => Quaternion a -> V3 a -> V3 a-rotate (Quaternion a' b c d) (V3 x y z) = V3- (2*((t8+t10)*x+(t6- t4)*y+(t3+t7)*z)+x)- (2*((t4+ t6)*y+(t5+t10)*y+(t9-t2)*z)+y)- (2*((t7- t3)*z+(t2+ t9)*z+(t5+t8)*z)+z)- where- a = -a'- t2 = a*b- t3 = a*c- t4 = a*d- t5 = -b*b- t6 = b*c- t7 = b*d- t8 = -c*c- t9 = c*d- t10 = -d*d--} {-# SPECIALIZE rotate :: Quaternion Float -> V3 Float -> V3 Float #-} {-# SPECIALIZE rotate :: Quaternion Double -> V3 Double -> V3 Double #-} instance (RealFloat a, Epsilon a) => Epsilon (Quaternion a) where nearZero = nearZero . quadrance+ {-# INLINE nearZero #-} -- | @'axisAngle' axis theta@ builds a 'Quaternion' representing a -- rotation of @theta@ radians about @axis@. axisAngle :: (Epsilon a, Floating a) => V3 a -> a -> Quaternion a axisAngle axis theta = normalize $ Quaternion (cos half) $ (sin half) *^ axis where half = theta / 2+{-# INLINE axisAngle #-}
src/Linear/V2.hs view
@@ -2,6 +2,18 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} -- {-# OPTIONS_GHC -fno-warn-name-shadowing #-}+-----------------------------------------------------------------------------+-- |+-- Module : Linear.V2+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- 2-D Vectors+---------------------------------------------------------------------------- module Linear.V2 ( V2(..) , R2(..)@@ -16,6 +28,7 @@ import Data.Monoid import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..))+import GHC.Arr (Ix(..)) import Linear.Metric import Linear.Epsilon @@ -24,69 +37,118 @@ instance Functor V2 where fmap f (V2 a b) = V2 (f a) (f b)+ {-# INLINE fmap #-}+ a <$ _ = V2 a a+ {-# INLINE (<$) #-} instance Foldable V2 where foldMap f (V2 a b) = f a `mappend` f b+ {-# INLINE foldMap #-} instance Traversable V2 where traverse f (V2 a b) = V2 <$> f a <*> f b+ {-# INLINE traverse #-} instance Applicative V2 where pure a = V2 a a+ {-# INLINE pure #-} V2 a b <*> V2 d e = V2 (a d) (b e)+ {-@ INLINE (<*>) #-} instance Monad V2 where return a = V2 a a+ {-# INLINE return #-} (>>=) = bindRep+ {-# INLINE (>>=) #-} instance Num a => Num (V2 a) where (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-} (*) = liftA2 (*)+ {-# INLINE (*) #-} negate = fmap negate+ {-# INLINE negate #-} abs = fmap abs+ {-# INLINE abs #-} signum = fmap signum+ {-# INLINE signum #-} fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-} instance Fractional a => Fractional (V2 a) where recip = fmap recip+ {-# INLINE recip #-} (/) = liftA2 (/)+ {-# INLINE (/) #-} fromRational = pure . fromRational+ {-# INLINE fromRational #-} instance Metric V2 where dot (V2 a b) (V2 c d) = a * c + b * d+ {-# INLINE dot #-} -- | A space that distinguishes 2 orthogonal basis vectors '_x' and '_y', but may have more. class R2 t where _x :: Functor f => (a -> f a) -> t a -> f (t a) _x = _xy._x+ {-# INLINE _x #-} _y :: Functor f => (a -> f a) -> t a -> f (t a) _y = _xy._y+ {-# INLINE _y #-} _xy :: Functor f => (V2 a -> f (V2 a)) -> t a -> f (t a) instance R2 V2 where _x f (V2 a b) = (`V2` b) <$> f a+ {-# INLINE _x #-} _y f (V2 a b) = (V2 a) <$> f b+ {-# INLINE _y #-} _xy = id+ {-# INLINE _xy #-} instance Representable V2 where rep f = V2 (f _x) (f _y)+ {-# INLINE rep #-} instance Distributive V2 where distribute f = V2 (fmap (^._x) f) (fmap (^._y) f)+ {-# INLINE distribute #-} -- | the counter-clockwise perpendicular vector perp :: Num a => V2 a -> V2 a perp (V2 a b) = V2 (negate b) a+{-# INLINE perp #-} instance Epsilon a => Epsilon (V2 a) where nearZero = nearZero . quadrance+ {-# INLINE nearZero #-} instance forall a. Storable a => Storable (V2 a) where sizeOf _ = 2 * sizeOf (undefined::a)+ {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)+ {-# INLINE alignment #-} poke ptr (V2 x y) = poke ptr' x >> pokeElemOff ptr' 1 y where ptr' = castPtr ptr+ {-# INLINE poke #-} peek ptr = V2 <$> peek ptr' <*> peekElemOff ptr' 1 where ptr' = castPtr ptr+ {-# INLINE peek #-}++instance Ix a => Ix (V2 a) where+ {-# SPECIALISE instance Ix (V2 Int) #-}++ range (V2 l1 l2,V2 u1 u2) =+ [ V2 i1 i2 | i1 <- range (l1,u1), i2 <- range (l2,u2) ]+ {-# INLINE range #-}++ unsafeIndex (V2 l1 l2,V2 u1 u2) (V2 i1 i2) =+ unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2+ {-# INLINE unsafeIndex #-}++ inRange (V2 l1 l2,V2 u1 u2) (V2 i1 i2) =+ inRange (l1,u1) i1 && inRange (l2,u2) i2+ {-# INLINE inRange #-}
src/Linear/V3.hs view
@@ -1,4 +1,16 @@ {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Linear.V3+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- 3-D Vectors+---------------------------------------------------------------------------- module Linear.V3 ( V3(..) , cross, triple@@ -14,6 +26,7 @@ import Data.Monoid import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..))+import GHC.Arr (Ix(..)) import Linear.Epsilon import Linear.Metric import Linear.V2@@ -23,33 +36,53 @@ instance Functor V3 where fmap f (V3 a b c) = V3 (f a) (f b) (f c)+ {-# INLINE fmap #-}+ a <$ _ = V3 a a a+ {-# INLINE (<$) #-} instance Foldable V3 where foldMap f (V3 a b c) = f a `mappend` f b `mappend` f c+ {-# INLINE foldMap #-} instance Traversable V3 where traverse f (V3 a b c) = V3 <$> f a <*> f b <*> f c+ {-# INLINE traverse #-} instance Applicative V3 where pure a = V3 a a a+ {-# INLINE pure #-} V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)+ {-# INLINE (<*>) #-} instance Monad V3 where return a = V3 a a a+ {-# INLINE return #-} (>>=) = bindRep+ {-# INLINE (>>=) #-} instance Num a => Num (V3 a) where (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-} (*) = liftA2 (*)+ {-# INLINE (*) #-} negate = fmap negate+ {-# INLINE negate #-} abs = fmap abs+ {-# INLINE abs #-} signum = fmap signum+ {-# INLINE signum #-} fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-} instance Fractional a => Fractional (V3 a) where recip = fmap recip+ {-# INLINE recip #-} (/) = liftA2 (/)+ {-# INLINE (/) #-} fromRational = pure . fromRational+ {-# INLINE fromRational #-} instance Metric V3 where dot (V3 a b c) (V3 d e f) = a * d + b * e + c * f@@ -57,6 +90,7 @@ instance Distributive V3 where distribute f = V3 (fmap (^._x) f) (fmap (^._y) f) (fmap (^._z) f)+ {-# INLINE distribute #-} -- | A space that distinguishes 3 orthogonal basis vectors: '_x', '_y', and '_z'. (It may have more) class R2 t => R3 t where@@ -65,25 +99,35 @@ instance R2 V3 where _x f (V3 a b c) = (\a' -> V3 a' b c) <$> f a+ {-# INLINE _x #-} _y f (V3 a b c) = (\b' -> V3 a b' c) <$> f b+ {-# INLINE _y #-} _xy f (V3 a b c) = (\(V2 a' b') -> V3 a' b' c) <$> f (V2 a b)+ {-# INLINE _xy #-} instance R3 V3 where _z f (V3 a b c) = V3 a b <$> f c+ {-# INLINE _z #-} _xyz = id+ {-# INLINE _xyz #-} instance Representable V3 where rep f = V3 (f _x) (f _y) (f _z)+ {-# INLINE rep #-} instance forall a. Storable a => Storable (V3 a) where sizeOf _ = 3 * sizeOf (undefined::a)+ {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)+ {-# INLINE alignment #-} poke ptr (V3 x y z) = do poke ptr' x pokeElemOff ptr' 1 y pokeElemOff ptr' 2 z where ptr' = castPtr ptr+ {-# INLINE poke #-} peek ptr = V3 <$> peek ptr' <*> peekElemOff ptr' 1 <*> peekElemOff ptr' 2 where ptr' = castPtr ptr+ {-# INLINE peek #-} -- | cross product cross :: Num a => V3 a -> V3 a -> V3 a@@ -93,6 +137,29 @@ -- | scalar triple product triple :: Num a => V3 a -> V3 a -> V3 a -> a triple a b c = dot a (cross b c)+{-# INLINE triple #-} instance Epsilon a => Epsilon (V3 a) where nearZero = nearZero . quadrance+ {-# INLINE nearZero #-}++instance Ix a => Ix (V3 a) where+ {-# SPECIALISE instance Ix (V3 Int) #-}++ range (V3 l1 l2 l3,V3 u1 u2 u3) =+ [V3 i1 i2 i3 | i1 <- range (l1,u1)+ , i2 <- range (l2,u2)+ , i3 <- range (l3,u3)+ ]+ {-# INLINE range #-}++ unsafeIndex (V3 l1 l2 l3,V3 u1 u2 u3) (V3 i1 i2 i3) =+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+ unsafeIndex (l1,u1) i1))+ {-# INLINE unsafeIndex #-}++ inRange (V3 l1 l2 l3,V3 u1 u2 u3) (V3 i1 i2 i3) =+ inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+ inRange (l3,u3) i3+ {-# INLINE inRange #-}
src/Linear/V4.hs view
@@ -1,4 +1,16 @@ {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Linear.V4+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- 4-D Vectors+---------------------------------------------------------------------------- module Linear.V4 ( V4(..) , vector, point@@ -15,6 +27,7 @@ import Data.Monoid import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..))+import GHC.Arr (Ix(..)) import Linear.Epsilon import Linear.Metric import Linear.V2@@ -25,39 +38,61 @@ instance Functor V4 where fmap f (V4 a b c d) = V4 (f a) (f b) (f c) (f d)+ {-# INLINE fmap #-}+ a <$ _ = V4 a a a a+ {-# INLINE (<$) #-} instance Foldable V4 where foldMap f (V4 a b c d) = f a `mappend` f b `mappend` f c `mappend` f d+ {-# INLINE foldMap #-} instance Traversable V4 where traverse f (V4 a b c d) = V4 <$> f a <*> f b <*> f c <*> f d+ {-# INLINE traverse #-} instance Applicative V4 where pure a = V4 a a a a+ {-# INLINE pure #-} V4 a b c d <*> V4 e f g h = V4 (a e) (b f) (c g) (d h)+ {-# INLINE (<*>) #-} instance Monad V4 where return a = V4 a a a a+ {-# INLINE return #-} (>>=) = bindRep+ {-# INLINE (>>=) #-} instance Num a => Num (V4 a) where (+) = liftA2 (+)+ {-# INLINE (+) #-} (*) = liftA2 (*)+ {-# INLINE (-) #-}+ (-) = liftA2 (-)+ {-# INLINE (*) #-} negate = fmap negate+ {-# INLINE negate #-} abs = fmap abs+ {-# INLINE abs #-} signum = fmap signum+ {-# INLINE signum #-} fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-} instance Fractional a => Fractional (V4 a) where recip = fmap recip+ {-# INLINE recip #-} (/) = liftA2 (/)+ {-# INLINE (/) #-} fromRational = pure . fromRational+ {-# INLINE fromRational #-} instance Metric V4 where dot (V4 a b c d) (V4 e f g h) = a * e + b * f + c * g + d * h+ {-# INLINE dot #-} instance Distributive V4 where distribute f = V4 (fmap (^._x) f) (fmap (^._y) f) (fmap (^._z) f) (fmap (^._w) f)+ {-# INLINE distribute #-} -- | A space that distinguishes orthogonal basis vectors '_x', '_y', '_z', '_w'. (It may have more.) class R3 t => R4 t where@@ -66,39 +101,77 @@ instance R2 V4 where _x f (V4 a b c d) = (\a' -> V4 a' b c d) <$> f a+ {-# INLINE _x #-} _y f (V4 a b c d) = (\b' -> V4 a b' c d) <$> f b+ {-# INLINE _y #-} _xy f (V4 a b c d) = (\(V2 a' b') -> V4 a' b' c d) <$> f (V2 a b)+ {-# INLINE _xy #-} instance R3 V4 where _z f (V4 a b c d) = (\c' -> V4 a b c' d) <$> f c+ {-# INLINE _z #-} _xyz f (V4 a b c d) = (\(V3 a' b' c') -> V4 a' b' c' d) <$> f (V3 a b c)+ {-# INLINE _xyz #-} instance R4 V4 where _w f (V4 a b c d) = V4 a b c <$> f d+ {-# INLINE _w #-} _xyzw = id+ {-# INLINE _xyzw #-} instance Representable V4 where rep f = V4 (f _x) (f _y) (f _z) (f _w)+ {-# INLINE rep #-} instance forall a. Storable a => Storable (V4 a) where sizeOf _ = 4 * sizeOf (undefined::a)+ {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)+ {-# INLINE alignment #-} poke ptr (V4 x y z w) = do poke ptr' x pokeElemOff ptr' 1 y pokeElemOff ptr' 2 z pokeElemOff ptr' 3 w where ptr' = castPtr ptr+ {-# INLINE poke #-} peek ptr = V4 <$> peek ptr' <*> peekElemOff ptr' 1 <*> peekElemOff ptr' 2 <*> peekElemOff ptr' 3 where ptr' = castPtr ptr+ {-# INLINE peek #-} -- | Convert a 3-dimensional affine vector into a 4-dimensional homogeneous vector. vector :: Num a => V3 a -> V4 a vector (V3 a b c) = V4 a b c 0+{-# INLINE vector #-} -- | Convert a 3-dimensional affine point into a 4-dimensional homogeneous vector. point :: Num a => V3 a -> V4 a point (V3 a b c) = V4 a b c 1+{-# INLINE point #-} instance Epsilon a => Epsilon (V4 a) where nearZero = nearZero . quadrance+ {-# INLINE nearZero #-}++instance Ix a => Ix (V4 a) where+ {-# SPECIALISE instance Ix (V4 Int) #-}++ range (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) =+ [V4 i1 i2 i3 i4 | i1 <- range (l1,u1)+ , i2 <- range (l2,u2)+ , i3 <- range (l3,u3)+ , i4 <- range (l4,u4)+ ]+ {-# INLINE range #-}++ unsafeIndex (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) (V4 i1 i2 i3 i4) =+ unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+ unsafeIndex (l1,u1) i1)))+ {-# INLINE unsafeIndex #-}++ inRange (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) (V4 i1 i2 i3 i4) =+ inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+ inRange (l3,u3) i3 && inRange (l4,u4) i4+ {-# INLINE inRange #-}
src/Linear/Vector.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : Linear.Epsilon+-- Module : Linear.Vector -- Copyright : (C) 2012 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com>
tests/doctests.hs view
@@ -1,11 +1,12 @@ module Main where -import Test.DocTest-import System.Directory-import System.FilePath+import Build_doctests (deps) import Control.Applicative import Control.Monad import Data.List+import System.Directory+import System.FilePath+import Test.DocTest main :: IO () main = getSources >>= \sources -> doctest $@@ -13,7 +14,8 @@ : "-idist/build/autogen" : "-optP-include" : "-optPdist/build/autogen/cabal_macros.h"- : sources+ : "-hide-all-packages"+ : map ("-package="++) deps ++ sources getSources :: IO [FilePath] getSources = filter (isSuffixOf ".hs") <$> go "src"
+ travis/cabal-apt-install view
@@ -0,0 +1,16 @@+#!/bin/sh+set -eu++sudo apt-get -q update+sudo apt-get -q -y install dctrl-tools++# Try installing some of the build-deps with apt-get for speed.+eval "$(+ printf '%s' "grep-aptavail -n -sPackage '(' -FFALSE -X FALSE ')'"+ 2>/dev/null cabal install "$@" --dry-run -v | \+ sed -nre "s/^([^ ]+)-[0-9.]+ \(.*$/ -o '(' -FPackage -X libghc-\1-dev ')'/p" | \+ xargs -d'\n'+)" | sort -u | xargs -d'\n' sudo apt-get -q -y install -- libghc-quickcheck2-dev++# Install whatever is still needed with cabal.+cabal install "$@"
+ travis/config view
@@ -0,0 +1,16 @@+-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix+--+-- This is particularly useful for travis-ci to get it to stop complaining+-- about a broken build when everything is still correct on our end.+--+-- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead+--+-- To enable this, uncomment the before_script in .travis.yml++remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive+remote-repo-cache: ~/.cabal/packages+world-file: ~/.cabal/world+build-summary: ~/.cabal/logs/build.log+remote-build-reporting: anonymous+install-dirs user+install-dirs global