diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,44 +0,0 @@ -#!/usr/bin/env runhaskell -\begin{code} -{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -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 = 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} diff --git a/digit.cabal b/digit.cabal --- a/digit.cabal +++ b/digit.cabal @@ -1,5 +1,5 @@ name: digit -version: 0.5.0 +version: 0.5.1 license: BSD3 license-file: LICENCE author: Queensland Functional Programming Lab @@ -40,6 +40,9 @@ ghc-options: -Wall + + default-extensions: + NoImplicitPrelude hs-source-dirs: src @@ -85,28 +88,38 @@ Data.Digit.Integral -test-suite doctests +test-suite tests type: exitcode-stdio-1.0 main-is: - doctests.hs + Main.hs default-language: Haskell2010 build-depends: - base < 5 && >= 4.8 - , doctest >= 0.9.7 - , filepath >= 1.3 - , directory >= 1.1 - , QuickCheck >= 2.0 - , template-haskell >= 2.8 - , parsec >= 3.1 - + base >=4.9 && <4.10 + , lens >=4.0 && <5 + , ansi-wl-pprint >=0.6 && <0.7 + , hedgehog >=0.5 && <0.6 + , tasty >=0.11 && <0.12 + , tasty-hspec >=1.1 && <1.2 + , papa >=0.3 && <0.4 + , parsec >=3.1 && <3.2 + , parsers >=0.12.3 && <0.13 + , pretty >=1.1 && <1.2 + , text >=1.2 && <1.3 + , tasty-hedgehog >=0.1 && <0.2 + , tasty-hunit >=0.9 && <0.10 + , digit + ghc-options: -Wall -threaded + + default-extensions: + NoImplicitPrelude hs-source-dirs: test diff --git a/src/Data/Digit/Char.hs b/src/Data/Digit/Char.hs --- a/src/Data/Digit/Char.hs +++ b/src/Data/Digit/Char.hs @@ -5,8 +5,8 @@ , charBinary , charOctalNoZero , charOctal -, charDecimal , charDecimalNoZero +, charDecimal , charHexadecimalNoZero , charHexadecimal , charHEXADECIMALNoZero @@ -52,10 +52,10 @@ -- | -- --- >>> '1' ^? charBinaryNoZero --- Just () +-- >>> '1' ^? charBinaryNoZero :: Maybe Digit +-- Just 1 -- --- >>> charBinaryNoZero # Digit1 :: Char +-- >>> charBinaryNoZero # Digit1 -- '1' -- -- prop> \c -> c /= '1' ==> (c ^? charBinaryNoZero == Nothing) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE RankNTypes #-} + +module Main( + main +) where + +import Data.Digit +import Papa hiding (re) +import Hedgehog(Gen, forAll, property, assert, (===)) +import Test.Tasty(TestTree, defaultMain, testGroup) +import Test.Tasty.Hedgehog(testProperty) +import Test.Tasty.HUnit(testCase, (@?=)) +import qualified Hedgehog.Gen as Gen(choice, integral, unicode, hexit, filter) +import qualified Hedgehog.Range as Range(linear) +import Text.Parsec(parse, ParseError, Parsec, eof) + +testPrism :: + (Show x, Eq x) => + Gen x + -> String + -> Prism' x Digit + -> [(x, Digit)] + -> [TestTree] +testPrism g n p x = + testProperty + (n ++ " prism invalid values") + ( + property $ + do c <- forAll . Gen.filter (`notElem` (map fst x)) $ g + (c ^? p :: Maybe Digit) === Nothing + ) : + ( + x >>= \(c, d) -> + [ + testCase + (n ++ " prism ->") + ((c ^? p :: Maybe Digit) @?= Just d) + , testCase + (n ++ " prism <-") + (p # d @?= c) + ] + ) + +testParser :: + String + -> Parsec String () Digit + -> [(Char, Digit)] + -> [TestTree] +testParser n p x = + ( + let n' = n ++ " parser invalid values" + in testProperty + n' + ( + property $ + do c <- forAll . Gen.filter (`notElem` (map fst x)) . Gen.choice $ [Gen.hexit, Gen.unicode] + assert (isLeft (parse p (n' ++ " test") [c] :: Either ParseError Digit)) + ) + ) : + ( + x >>= \(c, d) -> + [ + let n' = n ++ " parses exactly one character" + in testCase + n' + ((parse (p <* eof) (n' ++ " test") [c] :: Either ParseError Digit) @?= Right d) + , let n' = n ++ " parses the correct digit" + in testCase + n' + ((parse p (n' ++ "test") (c:"xyz") :: Either ParseError Digit) @?= Right d) + ] + ) + +integralPrism :: + (Show n, Integral n) => + String + -> Prism' n Digit + -> [(n, Digit)] + -> [TestTree] +integralPrism = + testPrism (Gen.choice [Gen.integral (Range.linear 0 9), Gen.integral (Range.linear 10 99999), Gen.integral (Range.linear (-1) (-99999))]) + +charPrism :: + String + -> Prism' Char Digit + -> [(Char, Digit)] + -> [TestTree] +charPrism = + testPrism (Gen.choice [Gen.hexit, Gen.unicode]) + +main :: + IO () +main = + defaultMain $ + testGroup "digit tests" $ + let q0 = ('0', Digit0) + q1 = ('1', Digit1) + q2 = ('2', Digit2) + q3 = ('3', Digit3) + q4 = ('4', Digit4) + q5 = ('5', Digit5) + q6 = ('6', Digit6) + q7 = ('7', Digit7) + q8 = ('8', Digit8) + q9 = ('9', Digit9) + qa = ('a', Digita) + qb = ('b', Digitb) + qc = ('c', Digitc) + qd = ('d', Digitd) + qe = ('e', Digite) + qf = ('f', Digitf) + qA = ('A', DigitA) + qB = ('B', DigitB) + qC = ('C', DigitC) + qD = ('D', DigitD) + qE = ('E', DigitE) + qF = ('F', DigitF) + r0 :: (Integer, Digit) + r0 = (0 , Digit0) + r1 :: (Integer, Digit) + r1 = (1 , Digit1) + r2 :: (Integer, Digit) + r2 = (2 , Digit2) + r3 :: (Integer, Digit) + r3 = (3 , Digit3) + r4 :: (Integer, Digit) + r4 = (4 , Digit4) + r5 :: (Integer, Digit) + r5 = (5 , Digit5) + r6 :: (Integer, Digit) + r6 = (6 , Digit6) + r7 :: (Integer, Digit) + r7 = (7 , Digit7) + r8 :: (Integer, Digit) + r8 = (8 , Digit8) + r9 :: (Integer, Digit) + r9 = (9 , Digit9) + ra :: (Integer, Digit) + ra = (10 , Digita) + rb :: (Integer, Digit) + rb = (11 , Digitb) + rc :: (Integer, Digit) + rc = (12 , Digitc) + rd :: (Integer, Digit) + rd = (13 , Digitd) + re :: (Integer, Digit) + re = (14 , Digite) + rf :: (Integer, Digit) + rf = (15 , Digitf) + rA :: (Integer, Digit) + rA = (10 , DigitA) + rB :: (Integer, Digit) + rB = (11 , DigitB) + rC :: (Integer, Digit) + rC = (12 , DigitC) + rD :: (Integer, Digit) + rD = (13 , DigitD) + rE :: (Integer, Digit) + rE = (14 , DigitE) + rF :: (Integer, Digit) + rF = (15 , DigitF) + in concat [ + charPrism "charBinaryNoZero" charBinaryNoZero [q1] + , charPrism "charBinary" charBinary [q0, q1] + , charPrism "charOctalNoZero" charOctalNoZero [q1, q2, q3, q4, q5, q6, q7] + , charPrism "charOctal" charOctal [q0, q1, q2, q3, q4, q5, q6, q7] + , charPrism "charDecimalNoZero" charDecimalNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9] + , charPrism "charDecimal" charDecimal [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9] + , charPrism "charHexadecimalNoZero" charHexadecimalNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf] + , charPrism "charHexadecimal" charHexadecimal [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf] + , charPrism "charHEXADECIMALNoZero" charHEXADECIMALNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9, qA, qB, qC, qD, qE, qF] + , charPrism "charHEXADECIMAL" charHEXADECIMAL [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9, qA, qB, qC, qD, qE, qF] + , charPrism "charHeXaDeCiMaLNoZero" charHeXaDeCiMaLNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf, qA, qB, qC, qD, qE, qF] + , charPrism "charHeXaDeCiMaL" charHeXaDeCiMaL [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf, qA, qB, qC, qD, qE, qF] + , integralPrism "integralBinaryNoZero" integralBinaryNoZero [r1] + , integralPrism "integralBinary" integralBinary [r0, r1] + , integralPrism "integralOctalNoZero" integralOctalNoZero [r1, r2, r3, r4, r5, r6, r7] + , integralPrism "integralOctal" integralOctal [r0, r1, r2, r3, r4, r5, r6, r7] + , integralPrism "integralDecimalNoZero" integralDecimalNoZero [r1, r2, r3, r4, r5, r6, r7, r8, r9] + , integralPrism "integralDecimal" integralDecimal [r0, r1, r2, r3, r4, r5, r6, r7, r8, r9] + , integralPrism "integralHexadecimalNoZero" integralHexadecimalNoZero [r1, r2, r3, r4, r5, r6, r7, r8, r9, ra, rb, rc, rd, re, rf] + , integralPrism "integralHexadecimal" integralHexadecimal [r0, r1, r2, r3, r4, r5, r6, r7, r8, r9, ra, rb, rc, rd, re, rf] + , integralPrism "integralHEXADECIMALNoZero" integralHEXADECIMALNoZero [r1, r2, r3, r4, r5, r6, r7, r8, r9, rA, rB, rC, rD, rE, rF] + , integralPrism "integralHEXADECIMAL" integralHEXADECIMAL [r0, r1, r2, r3, r4, r5, r6, r7, r8, r9, rA, rB, rC, rD, rE, rF] , testParser "parseBinaryNoZero" parseBinaryNoZero [q1] + , testParser "parseBinary" parseBinary [q0, q1] + , testParser "parseOctalNoZero" parseOctalNoZero [q1, q2, q3, q4, q5, q6, q7] + , testParser "parseOctal" parseOctal [q0, q1, q2, q3, q4, q5, q6, q7] + , testParser "parseDecimalNoZero" parseDecimalNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9] + , testParser "parseDecimal" parseDecimal [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9] + , testParser "parseHexadecimalNoZero" parseHexadecimalNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf] + , testParser "parseHexadecimal" parseHexadecimal [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf] + , testParser "parseHEXADECIMALNoZero" parseHEXADECIMALNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9, qA, qB, qC, qD, qE, qF] + , testParser "parseHEXADECIMALDecimal" parseHEXADECIMAL [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9, qA, qB, qC, qD, qE, qF] + , testParser "parseHeXaDeCiMaLNoZero" parseHeXaDeCiMaLNoZero [q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf, qA, qB, qC, qD, qE, qF] + , testParser "parseHeXaDeCiMaLDecimal" parseHeXaDeCiMaL [q0, q1, q2, q3, q4, q5, q6, q7, q8, q9, qa, qb, qc, qd, qe, qf, qA, qB, qC, qD, qE, qF] + , testParser "parse0" parse0 [q0] + , testParser "parse1" parse1 [q1] + , testParser "parse2" parse2 [q2] + , testParser "parse3" parse3 [q3] + , testParser "parse4" parse4 [q4] + , testParser "parse5" parse5 [q5] + , testParser "parse6" parse6 [q6] + , testParser "parse7" parse7 [q7] + , testParser "parse8" parse8 [q8] + , testParser "parse9" parse9 [q9] + , testParser "parsea" parsea [qa] + , testParser "parseb" parseb [qb] + , testParser "parsec" parsec [qc] + , testParser "parsed" parsed [qd] + , testParser "parsee" parsee [qe] + , testParser "parsef" parsef [qf] + , testParser "parseA" parseA [qA] + , testParser "parseB" parseB [qB] + , testParser "parseC" parseC [qC] + , testParser "parseD" parseD [qD] + , testParser "parseE" parseE [qE] + , testParser "parseF" parseF [qF] + , testParser "parseAa" parseAa [qA, qa] + , testParser "parseBb" parseBb [qB, qb] + , testParser "parseCc" parseCc [qC, qc] + , testParser "parseDd" parseDd [qD, qd] + , testParser "parseEe" parseEe [qE, qe] + , testParser "parseFf" parseFf [qF, qf] + ] diff --git a/test/doctests.hs b/test/doctests.hs deleted file mode 100644 --- a/test/doctests.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Main where - -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 $ - "-isrc" - : "-idist/build/autogen" - : "-optP-include" - : "-optPdist/build/autogen/cabal_macros.h" - : "-hide-all-packages" - : map ("-package="++) deps ++ sources - -getSources :: IO [FilePath] -getSources = filter (isSuffixOf ".hs") <$> go "src" - where - go dir = do - (dirs, files) <- getFilesAndDirectories dir - (files ++) . concat <$> mapM go dirs - -getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) -getFilesAndDirectories dir = do - c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir - (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c