finite-field-0.10.0/src/0000755000000000000000000000000013373465502013114 5ustar0000000000000000finite-field-0.10.0/src/Data/0000755000000000000000000000000013373465502013765 5ustar0000000000000000finite-field-0.10.0/src/Data/FiniteField/0000755000000000000000000000000013772605726016156 5ustar0000000000000000finite-field-0.10.0/test/0000755000000000000000000000000013772605726013313 5ustar0000000000000000finite-field-0.10.0/src/Data/FiniteField.hs0000644000000000000000000000107112337366607016507 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- module : Data.FiniteField -- Copyright : (c) Masahiro Sakai 2013 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional -- Portability : portable -- ----------------------------------------------------------------------------- module Data.FiniteField ( module Data.FiniteField.Base , module Data.FiniteField.PrimeField ) where import Data.FiniteField.Base import Data.FiniteField.PrimeField finite-field-0.10.0/src/Data/FiniteField/Base.hs0000644000000000000000000000167612337366633017373 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- module : Data.FiniteField.Base -- Copyright : (c) Masahiro Sakai 2013 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional -- Portability : portable -- ----------------------------------------------------------------------------- module Data.FiniteField.Base ( FiniteField (..) ) where -- | Type class for finite fields class Fractional k => FiniteField k where -- | The order is number of elements of a finite field @k@. -- It of the form @p^n@, where @p@ is prime number called the characteristic -- of the field, and @n@ is a positive integer. order :: k -> Integer -- | The characteristic of a field, @p@. char :: k -> Integer -- | The inverse of Frobenius endomorphism @x@ ↦ @x^p@. pthRoot :: k -> k -- | All values of a field allValues :: [k] finite-field-0.10.0/src/Data/FiniteField/PrimeField.hs0000644000000000000000000001055013772605726020533 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, BangPatterns #-} {-# LANGUAGE CPP, KindSignatures, DataKinds, ConstraintKinds #-} {-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- Module : Data.FiniteField.PrimeField -- Copyright : (c) Masahiro Sakai 2013-2014 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional -- Portability : non-portable (ScopedTypeVariables, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, BangPatterns) -- -- Finite field of prime order p, Fp = Z/pZ. -- -- References: -- -- * -- ----------------------------------------------------------------------------- module Data.FiniteField.PrimeField ( PrimeField , toInteger -- * Template haskell utilities -- $TH , primeField ) where import Prelude hiding (toInteger) import Control.DeepSeq import Data.Hashable import Data.Ratio (denominator, numerator) import Data.Typeable import qualified Language.Haskell.TH as TH #if !defined(UseGHCTypeLits) import qualified TypeLevel.Number.Nat as TL #else import GHC.TypeLits #endif import Data.FiniteField.Base -- | Finite field of prime order p, Fp = Z/pZ. -- -- NB: Primality of @p@ is assumed, but not checked. #if !defined(UseGHCTypeLits) newtype PrimeField p = PrimeField Integer deriving (Eq, Typeable) #else newtype PrimeField (p::Nat) = PrimeField Integer deriving (Eq, Typeable) #endif #if !defined(UseGHCTypeLits) type KnownNat p = TL.Nat p #endif -- | conversion to 'Integer' toInteger :: PrimeField p -> Integer toInteger (PrimeField a) = a toInt :: Integral a => PrimeField p -> a toInt = fromInteger . toInteger instance Show (PrimeField p) where showsPrec n (PrimeField x) = showsPrec n x instance KnownNat p => Read (PrimeField p) where readsPrec n s = [(fromInteger a, s') | (a,s') <- readsPrec n s] instance NFData (PrimeField p) where rnf (PrimeField a) = rnf a instance KnownNat p => Num (PrimeField p) where PrimeField a + PrimeField b = fromInteger $ a+b PrimeField a * PrimeField b = fromInteger $ a*b PrimeField a - PrimeField b = fromInteger $ a-b negate (PrimeField a) = fromInteger $ negate a abs a = a signum _ = 1 fromInteger a = ret where ret = PrimeField $ a `mod` char ret instance KnownNat p => Fractional (PrimeField p) where fromRational r = fromInteger (numerator r) / fromInteger (denominator r) -- recip a = a ^ (char a - 2 :: Integer) recip x@(PrimeField a) = case exgcd a p of (_, r, _) -> fromInteger r where p :: Integer p = char x instance KnownNat p => Bounded (PrimeField p) where minBound = PrimeField 0 maxBound = ret where ret = PrimeField (char ret - 1) instance KnownNat p => Enum (PrimeField p) where toEnum x | toInteger (minBound :: PrimeField p) <= x' && x' <= toInteger (maxBound :: PrimeField p) = PrimeField x' | otherwise = error "PrimeField.toEnum: bad argument" where x' = fromIntegral x fromEnum = toInt instance Ord (PrimeField p) where PrimeField a `compare` PrimeField b = a `compare` b instance KnownNat p => FiniteField (PrimeField p) where order x = char x #if !defined(UseGHCTypeLits) char _ = TL.toInt (undefined :: p) #else char _ = natVal (Proxy :: Proxy p) #endif pthRoot a = a allValues = [minBound .. maxBound] instance KnownNat p => Hashable (PrimeField p) where hashWithSalt s x@(PrimeField a) = s `hashWithSalt` char x `hashWithSalt` a -- | Extended GCD algorithm exgcd :: Integral a => a -> a -> (a, a, a) exgcd f1 f2 = f $ go f1 f2 1 0 0 1 where go !r0 !r1 !s0 !s1 !t0 !t1 | r1 == 0 = (r0, s0, t0) | otherwise = go r1 r2 s1 s2 t1 t2 where (q, r2) = r0 `divMod` r1 s2 = s0 - q*s1 t2 = t0 - q*t1 f (g,u,v) | g < 0 = (-g, -u, -v) | otherwise = (g,u,v) -- --------------------------------------------------------------------------- -- | Create a PrimeField type primeField :: Integer -> TH.TypeQ primeField n | n <= 0 = error "primeField: negative value" #if !defined(UseGHCTypeLits) | otherwise = [t| PrimeField $(TL.natT n) |] #else | otherwise = [t| PrimeField $(TH.litT (TH.numTyLit n)) |] #endif -- $TH -- Here is usage example for primeField: -- -- > a :: $(primeField 15485867) -- > a = 1 finite-field-0.10.0/test/TestPrimeField.hs0000644000000000000000000001656613772605726016545 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, GADTs, DataKinds, CPP, TypeOperators #-} {-# OPTIONS_GHC -fcontext-stack=32 #-} import Prelude hiding (toInteger) import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Test.Tasty.TH import qualified Test.QuickCheck.Monadic as QM import Control.DeepSeq import Control.Exception import Control.Monad import Data.Either import Data.Hashable import Data.List (genericLength) import Data.Numbers.Primes (primes) import Data.Proxy import Data.Ratio import Data.FiniteField #ifdef UseGHCTypeLits import Data.Maybe import GHC.TypeLits #else import TypeLevel.Number.Nat #endif -- ---------------------------------------------------------------------- -- addition prop_add_comm = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> a + b == b + a prop_add_assoc = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> (a + b) + c == a + (b + c) prop_add_unitl = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 0 + a == a prop_add_unitr = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a + 0 == a prop_negate = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a + negate a == 0 prop_sub_negate = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \(b :: PrimeField p) -> a - b == a + negate b -- ---------------------------------------------------------------------- -- multiplication prop_mult_comm = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> a * b == b * a prop_mult_assoc = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> (a * b) * c == a * (b * c) prop_mult_unitl = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 1 * a == a prop_mult_unitr = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a * 1 == a prop_mult_zero_l = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 0*a == 0 prop_mult_zero_r = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a*0 == 0 -- ---------------------------------------------------------------------- -- distributivity prop_distl = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> a * (b + c) == a*b + a*c prop_distr = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> (b + c) * a == b*a + c*a -- ---------------------------------------------------------------------- -- misc Num methods prop_abs = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> abs a == a prop_signum = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> signum a == 1 -- ---------------------------------------------------------------------- -- Fractional prop_fromRational = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(r :: Rational) -> (fromRational r :: PrimeField p) == fromInteger (numerator r) / fromInteger (denominator r) prop_recip = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a /= 0 ==> a * (recip a) == 1 -- ---------------------------------------------------------------------- -- FiniteField prop_pthRoot = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> pthRoot a ^ char a == a prop_allValues = do forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> genericLength (allValues :: [PrimeField p]) == order (undefined :: PrimeField p) -- ---------------------------------------------------------------------- -- Show / Read prop_read_show = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> read (show a) == a -- ---------------------------------------------------------------------- -- Ord prop_zero_minimum = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 0 <= a -- ---------------------------------------------------------------------- -- NFData prop_rnf = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> rnf a == () -- ---------------------------------------------------------------------- -- Enum prop_toEnum_fromEnum = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> toEnum (fromEnum a) == a prop_toEnum_negative = QM.monadicIO $ do SomeNat' (_ :: Proxy p) <- QM.pick smallPrimes let a :: PrimeField p a = toEnum (-1) (ret :: Either SomeException (PrimeField p)) <- QM.run $ try $ evaluate $ a QM.assert $ isLeft ret -- https://github.com/msakai/finite-field/issues/2 case_toEnum_big_integer = (toEnum 7 :: $(primeField (2^127 - 1))) @?= 7 -- ---------------------------------------------------------------------- prop_hash = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> hash a `seq` () == () -- ---------------------------------------------------------------------- -- misc prop_fromInteger_toInteger = forAll smallPrimes $ \(SomeNat' (_ :: Proxy p)) -> forAll arbitrary $ \(a :: PrimeField p) -> fromInteger (toInteger a) == a case_primeFieldT = a @?= 1 where a :: $(primeField 15485867) a = 15485867 + 1 ------------------------------------------------------------------------ #ifdef UseGHCTypeLits data SomeNat' where SomeNat' :: KnownNat p => Proxy p -> SomeNat' instance Show SomeNat' where showsPrec p (SomeNat' x) = showsPrec p (natVal x) #else data SomeNat' where SomeNat' :: Nat p => Proxy p -> SomeNat' instance Show SomeNat' where showsPrec p (SomeNat' (x :: Proxy p)) = showsPrec p (toInt (undefined :: p)) #endif smallPrimes :: Gen SomeNat' smallPrimes = do i <- choose (0, 2^(16::Int)) #ifdef UseGHCTypeLits case fromJust $ someNatVal $ primes !! i of SomeNat proxy -> return $ SomeNat' proxy #else let f :: forall p. Nat p => p -> SomeNat' f _ = SomeNat' (Proxy :: Proxy p) return $ withNat f (primes !! i) #endif #ifdef UseGHCTypeLits instance KnownNat p => Arbitrary (PrimeField p) where #else instance Nat p => Arbitrary (PrimeField p) where #endif arbitrary = liftM fromInteger arbitrary ------------------------------------------------------------------------ -- Test harness main :: IO () main = $(defaultMainGenerator) #if !MIN_VERSION_base(4,7,0) isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True #endif finite-field-0.10.0/COPYING0000644000000000000000000000262012137601102013341 0ustar0000000000000000Copyright 2013 Masahiro Sakai. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. finite-field-0.10.0/Setup.lhs0000755000000000000000000000012211722721355014130 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain finite-field-0.10.0/finite-field.cabal0000644000000000000000000000416413772605726015664 0ustar0000000000000000Name: finite-field Version: 0.10.0 License: BSD3 License-File: COPYING Author: Masahiro Sakai (masahiro.sakai@gmail.com) Maintainer: masahiro.sakai@gmail.com Category: Math, Algebra, Data Cabal-Version: >= 1.10 Synopsis: Finite Fields Description: This is an implementation of finite fields. Currently only prime fields are supported. Bug-Reports: https://github.com/msakai/finite-field/issues Extra-Source-Files: README.md COPYING CHANGELOG.markdown .travis.yml .gitignore Build-Type: Simple Tested-With: GHC ==7.8.4 GHC ==7.10.3 GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.2 Flag UseGHCTypeLits Description: set GHC.TypeLits module Default: True Manual: True source-repository head type: git location: git://github.com/msakai/finite-field.git Library Hs-source-dirs: src Build-Depends: base >=4 && <5, template-haskell, deepseq, hashable if flag(UseGHCTypeLits) Build-Depends: base >=4.7, singletons >=1.0 CPP-OPtions: "-DUseGHCTypeLits" else Build-Depends: type-level-numbers >=0.1.1.0 && <0.2.0.0 Default-Language: Haskell2010 Other-Extensions: ConstraintKinds DeriveDataTypeable MultiParamTypeClasses ScopedTypeVariables Rank2Types GADTs TemplateHaskell BangPatterns Exposed-Modules: Data.FiniteField Data.FiniteField.Base Data.FiniteField.PrimeField Test-suite TestPrimeField Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-is: TestPrimeField.hs Build-depends: base >=4 && <5, containers, deepseq, hashable, tasty >=0.10.1, tasty-hunit >=0.9 && <0.11, tasty-quickcheck >=0.8 && <0.11, tasty-th, QuickCheck >=2.5 && <3, finite-field, primes if flag(UseGHCTypeLits) Build-Depends: base >=4.7, singletons >=1.0 CPP-OPtions: "-DUseGHCTypeLits" else Build-depends: type-level-numbers >=0.1.1.0 && <0.2.0.0 if impl(ghc<7.7) Build-Depends: tagged Default-Language: Haskell2010 Other-Extensions: TemplateHaskell ScopedTypeVariables CPP finite-field-0.10.0/README.md0000644000000000000000000000120013323004620013556 0ustar0000000000000000finite-field ============ [![Build Status](https://travis-ci.org/msakai/finite-field.svg?branch=master)](https://travis-ci.org/msakai/finite-field) [![Hackage](https://img.shields.io/hackage/v/finite-field.svg)](https://hackage.haskell.org/package/finite-field) [![Hackage Deps](https://img.shields.io/hackage-deps/v/finite-field.svg)](https://packdeps.haskellers.com/feed?needle=finite-field) [![Coverage Status](https://coveralls.io/repos/msakai/finite-field/badge.svg)](https://coveralls.io/r/msakai/finite-field) [![License](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) finite-field-0.10.0/CHANGELOG.markdown0000644000000000000000000000120213774023345015353 0ustar00000000000000000.10.0 ------ * fix `toEnum` to work when `p` is beyond Int's `maxBound`. 0.9.0 ----- * use `tasty` instead of `test-framework` for testing * add `UseGHCTypeLits` flag to switch to use GHC's type-level natural numbers instead of `type-level-numbers` package 0.8.0 ----- * remove dependency on `algebra` package, since it is outdated and not compatible with recent version of other packages 0.7.0 ----- * use extended GCD to compute reciprocals * conform with the addition of SomeNat type to type-level-numbers-0.1.1.0. 0.6.0 ----- * add Hashable instance * add allValues to FiniteField class . 0.5.0 ----- * introduce FiniteField class finite-field-0.10.0/.travis.yml0000644000000000000000000001065313772605726014452 0ustar0000000000000000language: c sudo: false dist: bionic cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=2.0 GHCVER=7.8.4 COVERAGE=1 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-2.0,ghc-7.8.4,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=7.10.3 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-2.0,ghc-7.10.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=8.0.2 compiler: ": #GHC 8.0.2" addons: {apt: {packages: [cabal-install-2.0,ghc-8.0.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=8.2.2 compiler: ": #GHC 8.2.2" addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=8.4.4 compiler: ": #GHC 8.4.4" addons: {apt: {packages: [cabal-install-2.0,ghc-8.4.4,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=8.6.5 compiler: ": #GHC 8.6.5" addons: {apt: {packages: [cabal-install-2.0,ghc-8.6.5,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.4 GHCVER=8.8.4 compiler: ": #GHC 8.8.4" addons: {apt: {packages: [cabal-install-2.4,ghc-8.8.4,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.4 GHCVER=8.10.2 compiler: ": #GHC 8.10.2" addons: {apt: {packages: [cabal-install-2.4,ghc-8.10.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} before_install: - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:~/.cabal/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 $([ "$COVERAGE" = "1" ] && echo "--enable-library-coverage") # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - cabal check - cabal sdist # tests that a source-distribution can be generated # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") # This block must be executed before before_cache #after_script: - "[ -n \"$COVERAGE\" ] && cabal install hpc-coveralls --avoid-reinstalls --constraint=\"regex-posix >=0.95.2\" || true" # regex-posix-0.95.1 has compilation problem - "[ -n \"$COVERAGE\" ] && hpc-coveralls TestPrimeField --exclude-dir=test || true" finite-field-0.10.0/.gitignore0000644000000000000000000000007712774104273014320 0ustar0000000000000000dist cabal-dev *.o *.hi *.chi *.chs.h .virthualenv .stack-work