diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,44 @@ +#!/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 new file mode 100644 --- /dev/null +++ b/digit.cabal @@ -0,0 +1,79 @@ +name: digit +version: 0.1.0 +license: BSD3 +license-File: etc/LICENCE +author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> +maintainer: Tony Morris +copyright: Copyright (C) 2010-2013 NICTA Limited +synopsis: A data-type representing digits 0-9 and other combinations +category: Data +homepage: https://github.com/NICTA/digit +bug-reports: https://github.com/NICTA/digit/issues +cabal-version: >= 1.10 +build-type: Custom +extra-source-files: etc/CONTRIBUTORS +description: + <> + . + @Digit@ is a data-type that represents the digits 0-9 and other combinations. + +source-repository head + type: git + location: git@github.com:NICTA/digit.git + +flag small_base + description: Choose the new, split-up base package. + +library + default-language: + Haskell2010 + + build-depends: + base < 5 && >= 3 + , lens >= 3.9.2 && <= 3.10 + + ghc-options: + -Wall + + hs-source-dirs: + src + + exposed-modules: + Data.Digit + Data.Digit.D0 + Data.Digit.D1 + Data.Digit.D2 + Data.Digit.D3 + Data.Digit.D4 + Data.Digit.D5 + Data.Digit.D6 + Data.Digit.D7 + Data.Digit.D8 + Data.Digit.D9 + Data.Digit.Digit + Data.Digit.Digit1_8 + Data.Digit.Digit1_9 + +test-suite doctests + type: + exitcode-stdio-1.0 + + main-is: + doctests.hs + + default-language: + Haskell2010 + + build-depends: + base < 5 && >= 3, + doctest >= 0.9.7, + filepath >= 1.3, + directory >= 1.1, + QuickCheck >= 2.0 + + ghc-options: + -Wall + -threaded + + hs-source-dirs: + test diff --git a/etc/CONTRIBUTORS b/etc/CONTRIBUTORS new file mode 100644 --- /dev/null +++ b/etc/CONTRIBUTORS @@ -0,0 +1,33 @@ +Tony Morris +tmorris@tmorris.net +http://tmorris.net/ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.6 (GNU/Linux) + +mQGiBETNyC0RBAC3MYSZSbDZhBLKra2YUphB9OO6+qMFl/v2Lq8590ZfeE2WjIOu +c/KGKyOigXztMrA4+iekUjM4FA8E6AlBRQiAqZK8HF0ftX5hDpuSyEKkZe3jcxxI +BbhwX/SWHtDEVzwNmvO1wEnwhRE1oY/BCmy+bQ9wmAjlNav4UbOIcXcJUwCgz6FF +UwDvPxzybgd9FNS14BE37n8D/AzGmGjunBW/x+g/ndwu6WEpTEn1ZNdja6VrNXSG +xQ8XM+NBulroAIYX+YWdHsKnuGvSKCgVoc1ifVHdztA9sksID5GBGzhmVbIP2E16 +w/LEzqqwruv9dX0Y1b7n8hcnvbl4DgEgLgeQ+VgJfLUkY2jFZ2m3dEBRH9USSgB/ +V2pBBACP4Us2ZBYEXtMG29g6GqyeeJLEP34PLYVHWJZbet/wPQsHFhYahhzjwZGG +Srp0JUpegJOdaqX/Y0nio2whgCpqJcrbGuUBqNgQI3k4gvBwnPyx7jM0kfHfFORG +lq9SDbfLpV0EJx6fWXGStW33zsQQvenDcV2F5czzKQcy66BFwbQhVG9ueSBNb3Jy +aXMgPHRtb3JyaXNAdG1vcnJpcy5uZXQ+iGMEExECACMFAkTNyC0FCQlmAYAGCwkI +BwMCBBUCCAMEFgIDAQIeAQIXgAAKCRCaemCth7qvrf0pAKCFii2pI2W1BKVFuQcw +yoNxP0CAUACgyhuI9isCvtrOkeyjDmCVueRCdaC5Ag0ERM3IThAIAJ6A1z+d40ve +WvPIhpFiGfoS8UX4YdgYpo2mC/orY0xszBitogtaTHQHU5YDemGg81plNg9I3DbM +Er8uyONV4DqF6RbLj4w+iA6zn93+PTEZ73ydhxF6vDuojpVZPXVzXzpgyXHkEVLC +3hKL9oVlEsh+DWCvCiSAIy780JZ3FNVuMC3VH4qKxTw0CwPuuZvVfnMoIRfpODRR +fVEk2VDor+lr8kqJkBaHgN5o/AvOXC7QCYadwbEkpr0ecxIZ1VcASYytIIM3YNL7 +ZcHWwU5PCNLOdMXPqOdthhDhsHkKJNEXXr0YsjX/bQqYOUqYKPDyqh/yrrRO9Ro6 +7eTSbfIguycAAwcH/2waLIQR8qYKxPknNuSdsOOqF2jf2gglL/7uMsIzjfkFzgHo ++GNHw9tmlZqD3yzaZ/N7Yv08ujRHhmWPBYAWRICBM3qo0zMJ9kI5XWRobeRQpLtf +YxxIOenq8R9t6YU9ryHdqf+P+Fi38eN5ERTDhNLrJOnO5/TA+of97BWCmdtJMlWM +RaHtqXxwo02Yi65IqKx6L7oOvT7Gh4NV2eglz8ZafPEoP8+V8ER7rwBYPiLk4Mse +oVImjveq2dmLUip9OPwznoaeyC8zB0mJ13m/KNC+CffkBgoXpMPiKzbu5YTjVw++ +MlEmfgL42yDK0hnokmW2i9y1RBh/T1VQQeQbUaeITAQYEQIADAUCRM3ITgUJCWYB +gAAKCRCaemCth7qvrcbtAJ9j3C6lKNRB3uKcrfze66jAVQh0qACaAysOK82TcQ/2 +73ryR0xWMFnpGqg= +=bMTb +-----END PGP PUBLIC KEY BLOCK----- diff --git a/etc/LICENCE b/etc/LICENCE new file mode 100644 --- /dev/null +++ b/etc/LICENCE @@ -0,0 +1,27 @@ +Copyright 2013 NICTA Limited + +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. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND 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 AUTHORS OR 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. diff --git a/src/Data/Digit.hs b/src/Data/Digit.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit.hs @@ -0,0 +1,15 @@ +module Data.Digit(module D) where + +import Data.Digit.D0 as D +import Data.Digit.D1 as D +import Data.Digit.D2 as D +import Data.Digit.D3 as D +import Data.Digit.D4 as D +import Data.Digit.D5 as D +import Data.Digit.D6 as D +import Data.Digit.D7 as D +import Data.Digit.D8 as D +import Data.Digit.D9 as D +import Data.Digit.Digit as D +import Data.Digit.Digit1_8 as D +import Data.Digit.Digit1_9 as D diff --git a/src/Data/Digit/D0.hs b/src/Data/Digit/D0.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D0.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D0 where + +import Prelude(Eq) + +class Eq a => D0 a where + d0 :: + a diff --git a/src/Data/Digit/D1.hs b/src/Data/Digit/D1.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D1.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D1 where + +import Prelude(Eq) + +class Eq a => D1 a where + d1 :: + a diff --git a/src/Data/Digit/D2.hs b/src/Data/Digit/D2.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D2 where + +import Prelude(Eq) + +class Eq a => D2 a where + d2 :: + a diff --git a/src/Data/Digit/D3.hs b/src/Data/Digit/D3.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D3 where + +import Prelude(Eq) + +class Eq a => D3 a where + d3 :: + a diff --git a/src/Data/Digit/D4.hs b/src/Data/Digit/D4.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D4.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D4 where + +import Prelude(Eq) + +class Eq a => D4 a where + d4 :: + a diff --git a/src/Data/Digit/D5.hs b/src/Data/Digit/D5.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D5.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D5 where + +import Prelude(Eq) + +class Eq a => D5 a where + d5 :: + a diff --git a/src/Data/Digit/D6.hs b/src/Data/Digit/D6.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D6.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D6 where + +import Prelude(Eq) + +class Eq a => D6 a where + d6 :: + a diff --git a/src/Data/Digit/D7.hs b/src/Data/Digit/D7.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D7.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D7 where + +import Prelude(Eq) + +class Eq a => D7 a where + d7 :: + a diff --git a/src/Data/Digit/D8.hs b/src/Data/Digit/D8.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D8.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D8 where + +import Prelude(Eq) + +class Eq a => D8 a where + d8 :: + a diff --git a/src/Data/Digit/D9.hs b/src/Data/Digit/D9.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/D9.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digit.D9 where + +import Prelude(Eq) + +class Eq a => D9 a where + d9 :: + a diff --git a/src/Data/Digit/Digit.hs b/src/Data/Digit/Digit.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/Digit.hs @@ -0,0 +1,231 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | A data type with ten nullary constructors [0-9] and combinators. +module Data.Digit.Digit +( +-- * Data type + Digit +-- * Destructors +, foldDigit +-- * Prisms +, digit +, digitC +) where + +import Prelude(Show(..), Read(..), Eq, Enum(..), Maybe(..), Bounded, Ord, Int, Char, (.)) +import Data.Digit.D0 +import Data.Digit.D1 +import Data.Digit.D2 +import Data.Digit.D3 +import Data.Digit.D4 +import Data.Digit.D5 +import Data.Digit.D6 +import Data.Digit.D7 +import Data.Digit.D8 +import Data.Digit.D9 +import Control.Lens + +-- $setup +-- >>> import Prelude + +-- | A data type with ten nullary constructors. +data Digit = + D0 + | D1 + | D2 + | D3 + | D4 + | D5 + | D6 + | D7 + | D8 + | D9 + deriving (Eq, Ord, Enum, Bounded) + +-- | Catamorphism for @Digit@. +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d0 == x0 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d1 == x1 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d2 == x2 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d3 == x3 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d4 == x4 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d5 == x5 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d6 == x6 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d7 == x7 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d8 == x8 +-- +-- prop> foldDigit x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 d9 == x9 +foldDigit :: + a -- ^ Zero. + -> a -- ^ One. + -> a -- ^ Two. + -> a -- ^ Three. + -> a -- ^ Four. + -> a -- ^ Five. + -> a -- ^ Six. + -> a -- ^ Seven. + -> a -- ^ Eight. + -> a -- ^ Nine. + -> Digit -- ^ The digit to fold. + -> a +foldDigit x0 _ _ _ _ _ _ _ _ _ D0 = + x0 +foldDigit _ x1 _ _ _ _ _ _ _ _ D1 = + x1 +foldDigit _ _ x2 _ _ _ _ _ _ _ D2 = + x2 +foldDigit _ _ _ x3 _ _ _ _ _ _ D3 = + x3 +foldDigit _ _ _ _ x4 _ _ _ _ _ D4 = + x4 +foldDigit _ _ _ _ _ x5 _ _ _ _ D5 = + x5 +foldDigit _ _ _ _ _ _ x6 _ _ _ D6 = + x6 +foldDigit _ _ _ _ _ _ _ x7 _ _ D7 = + x7 +foldDigit _ _ _ _ _ _ _ _ x8 _ D8 = + x8 +foldDigit _ _ _ _ _ _ _ _ _ x9 D9 = + x9 + +instance D0 Digit where + d0 = + D0 + +instance D1 Digit where + d1 = + D1 + +instance D2 Digit where + d2 = + D2 + +instance D3 Digit where + d3 = + D3 + +instance D4 Digit where + d4 = + D4 + +instance D5 Digit where + d5 = + D5 + +instance D6 Digit where + d6 = + D6 + +instance D7 Digit where + d7 = + D7 + +instance D8 Digit where + d8 = + D8 + +instance D9 Digit where + d9 = + D9 + +-- | A prism for using @Int@ as @Digit@. +-- +-- >>> 5 ^? digit +-- Just 5 +-- +-- >>> 0 ^? digit +-- Just 0 +-- +-- >>> 9 ^? digit +-- Just 9 +-- +-- >>> 10 ^? digit +-- Nothing +-- +-- >>> (-5) ^? digit +-- Nothing +digit :: + Prism' Int Digit +digit = + prism' + fromEnum + (\n -> case n of 0 -> Just D0 + 1 -> Just D1 + 2 -> Just D2 + 3 -> Just D3 + 4 -> Just D4 + 5 -> Just D5 + 6 -> Just D6 + 7 -> Just D7 + 8 -> Just D8 + 9 -> Just D9 + _ -> Nothing) + +-- | A prism for using @Char@ as @Digit@. +-- +-- >>> '5' ^? digitC +-- Just 5 +-- +-- >>> '0' ^? digitC +-- Just 0 +-- +-- >>> '9' ^? digitC +-- Just 9 +-- +-- >>> 'a' ^? digitC +-- Nothing +-- +-- >>> '@' ^? digitC +-- Nothing +digitC :: + Prism' Char Digit +digitC = + prism' + (let f = f in f) + (\n -> case n of '0' -> Just D0 + '1' -> Just D1 + '2' -> Just D2 + '3' -> Just D3 + '4' -> Just D4 + '5' -> Just D5 + '6' -> Just D6 + '7' -> Just D7 + '8' -> Just D8 + '9' -> Just D9 + _ -> Nothing) + +instance Show Digit where + show = show . fromEnum + +instance Read Digit where + readsPrec _ ('0':t) = + [(D0, t)] + readsPrec _ ('1':t) = + [(D1, t)] + readsPrec _ ('2':t) = + [(D2, t)] + readsPrec _ ('3':t) = + [(D3, t)] + readsPrec _ ('4':t) = + [(D4, t)] + readsPrec _ ('5':t) = + [(D5, t)] + readsPrec _ ('6':t) = + [(D6, t)] + readsPrec _ ('7':t) = + [(D7, t)] + readsPrec _ ('8':t) = + [(D8, t)] + readsPrec _ ('9':t) = + [(D9, t)] + readsPrec _ _ = + [] diff --git a/src/Data/Digit/Digit1_8.hs b/src/Data/Digit/Digit1_8.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/Digit1_8.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | A data type with eight nullary constructors [1-8] and combinators. +module Data.Digit.Digit1_8 +( +-- * Data type + Digit1_8 +-- * Destructors +, foldDigit1_8 +-- * Prisms +, digit1_8 +, digitC1_8 +, digit1_8digit +, digit1_8digit1_9 +) where + +import Prelude(Show(..), Read(..), Eq, Enum(..), Maybe(..), Bounded, Ord, Int, Char, (.)) +import Data.Digit.Digit(Digit, digit, digitC) +import Data.Digit.Digit1_9(Digit1_9, foldDigit1_9, digit1_9digit) +import Data.Digit.D1 +import Data.Digit.D2 +import Data.Digit.D3 +import Data.Digit.D4 +import Data.Digit.D5 +import Data.Digit.D6 +import Data.Digit.D7 +import Data.Digit.D8 +import Control.Lens + +-- $setup +-- >>> import Prelude +-- >>> import Data.Digit.D0 +-- >>> import Data.Digit.D9 + +-- | A data type with eight nullary constructors. +data Digit1_8 = + D1 + | D2 + | D3 + | D4 + | D5 + | D6 + | D7 + | D8 + deriving (Eq, Ord, Bounded) + +-- | Catamorphism for @Digit1_8@. +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d1 == x1 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d2 == x2 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d3 == x3 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d4 == x4 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d5 == x5 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d6 == x6 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d7 == x7 +-- +-- prop> foldDigit1_8 x1 x2 x3 x4 x5 x6 x7 x8 d8 == x8 +foldDigit1_8 :: + a -- ^ One. + -> a -- ^ Two. + -> a -- ^ Three. + -> a -- ^ Four. + -> a -- ^ Five. + -> a -- ^ Six. + -> a -- ^ Seven. + -> a -- ^ Eight. + -> Digit1_8 -- ^ The digit to fold. + -> a +foldDigit1_8 x1 _ _ _ _ _ _ _ D1 = + x1 +foldDigit1_8 _ x2 _ _ _ _ _ _ D2 = + x2 +foldDigit1_8 _ _ x3 _ _ _ _ _ D3 = + x3 +foldDigit1_8 _ _ _ x4 _ _ _ _ D4 = + x4 +foldDigit1_8 _ _ _ _ x5 _ _ _ D5 = + x5 +foldDigit1_8 _ _ _ _ _ x6 _ _ D6 = + x6 +foldDigit1_8 _ _ _ _ _ _ x7 _ D7 = + x7 +foldDigit1_8 _ _ _ _ _ _ _ x8 D8 = + x8 + +instance D1 Digit1_8 where + d1 = + D1 + +instance D2 Digit1_8 where + d2 = + D2 + +instance D3 Digit1_8 where + d3 = + D3 + +instance D4 Digit1_8 where + d4 = + D4 + +instance D5 Digit1_8 where + d5 = + D5 + +instance D6 Digit1_8 where + d6 = + D6 + +instance D7 Digit1_8 where + d7 = + D7 + +instance D8 Digit1_8 where + d8 = + D8 + +-- | A prism for using @Int@ as @Digit1_8@. +-- +-- >>> 5 ^? digit1_8 +-- Just 5 +-- +-- >>> 0 ^? digit1_8 +-- Nothing +-- +-- >>> 8 ^? digit1_8 +-- Just 8 +-- +-- >>> 9 ^? digit1_8 +-- Nothing +-- +-- >>> 10 ^? digit1_8 +-- Nothing +-- +-- >>> (-5) ^? digit1_8 +-- Nothing +digit1_8 :: + Prism' Int Digit1_8 +digit1_8 = + digit . digit1_8digit + +-- | A prism for using @Char@ as @Digit1_8@. +-- +-- >>> '5' ^? digitC1_8 +-- Just 5 +-- +-- >>> '0' ^? digitC1_8 +-- Nothing +-- +-- >>> '8' ^? digitC1_8 +-- Just 8 +-- +-- >>> '9' ^? digitC1_8 +-- Nothing +-- +-- >>> 'x' ^? digitC1_8 +-- Nothing +-- +-- >>> '*' ^? digitC1_8 +-- Nothing +digitC1_8 :: + Prism' Char Digit1_8 +digitC1_8 = + digitC . digit1_8digit + +-- | A prism for using @Digit@ as @Digit1_8@. +-- +-- >>> d5 ^? digit1_8digit +-- Just 5 +-- +-- >>> d0 ^? digit1_8digit +-- Nothing +-- +-- >>> d8 ^? digit1_8digit +-- Just 8 +-- +-- >>> d9 ^? digit1_8digit +-- Nothing +-- +-- >>> d1 ^? digit1_8digit +-- Just 1 +digit1_8digit :: + Prism' Digit Digit1_8 +digit1_8digit = + digit1_9digit . digit1_8digit1_9 + +-- | A prism for using @Digit1_9@ as @Digit1_8@. +-- +-- >>> d5 ^? digit1_8digit1_9 +-- Just 5 +-- +-- >>> d8 ^? digit1_8digit1_9 +-- Just 8 +-- +-- >>> d9 ^? digit1_8digit1_9 +-- Nothing +-- +-- >>> d1 ^? digit1_8digit1_9 +-- Just 1 +digit1_8digit1_9 :: + Prism' Digit1_9 Digit1_8 +digit1_8digit1_9 = + prism' + (foldDigit1_8 + d1 + d2 + d3 + d4 + d5 + d6 + d7 + d8) + (foldDigit1_9 + (Just D1) + (Just D2) + (Just D3) + (Just D4) + (Just D5) + (Just D6) + (Just D7) + (Just D8) + Nothing) + + +instance Show Digit1_8 where + show d = + show (digit1_8 # d) + +instance Read Digit1_8 where + readsPrec _ ('1':t) = + [(D1, t)] + readsPrec _ ('2':t) = + [(D2, t)] + readsPrec _ ('3':t) = + [(D3, t)] + readsPrec _ ('4':t) = + [(D4, t)] + readsPrec _ ('5':t) = + [(D5, t)] + readsPrec _ ('6':t) = + [(D6, t)] + readsPrec _ ('7':t) = + [(D7, t)] + readsPrec _ ('8':t) = + [(D8, t)] + readsPrec _ _ = + [] diff --git a/src/Data/Digit/Digit1_9.hs b/src/Data/Digit/Digit1_9.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digit/Digit1_9.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | A data type with nine nullary constructors [1-9] and combinators. +module Data.Digit.Digit1_9 +( +-- * Data type + Digit1_9 +-- * Destructors +, foldDigit1_9 +-- * Prisms +, digit1_9 +, digitC1_9 +, digit1_9digit +) where + +import Prelude(Show(..), Read(..), Eq, Enum(..), Maybe(..), Bounded, Ord, Int, Char, (.)) +import Data.Digit.Digit(Digit, foldDigit, digit, digitC) +import Data.Digit.D1 +import Data.Digit.D2 +import Data.Digit.D3 +import Data.Digit.D4 +import Data.Digit.D5 +import Data.Digit.D6 +import Data.Digit.D7 +import Data.Digit.D8 +import Data.Digit.D9 +import Control.Lens + +-- $setup +-- >>> import Prelude +-- >>> import Data.Digit.D0 + +-- | A data type with nine nullary constructors. +data Digit1_9 = + D1 + | D2 + | D3 + | D4 + | D5 + | D6 + | D7 + | D8 + | D9 + deriving (Eq, Ord, Bounded) + +-- | Catamorphism for @Digit1_9@. +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d1 == x1 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d2 == x2 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d3 == x3 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d4 == x4 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d5 == x5 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d6 == x6 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d7 == x7 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d8 == x8 +-- +-- prop> foldDigit1_9 x1 x2 x3 x4 x5 x6 x7 x8 x9 d9 == x9 +foldDigit1_9 :: + a -- ^ One. + -> a -- ^ Two. + -> a -- ^ Three. + -> a -- ^ Four. + -> a -- ^ Five. + -> a -- ^ Six. + -> a -- ^ Seven. + -> a -- ^ Eight. + -> a -- ^ Nine. + -> Digit1_9 -- ^ The digit to fold. + -> a +foldDigit1_9 x1 _ _ _ _ _ _ _ _ D1 = + x1 +foldDigit1_9 _ x2 _ _ _ _ _ _ _ D2 = + x2 +foldDigit1_9 _ _ x3 _ _ _ _ _ _ D3 = + x3 +foldDigit1_9 _ _ _ x4 _ _ _ _ _ D4 = + x4 +foldDigit1_9 _ _ _ _ x5 _ _ _ _ D5 = + x5 +foldDigit1_9 _ _ _ _ _ x6 _ _ _ D6 = + x6 +foldDigit1_9 _ _ _ _ _ _ x7 _ _ D7 = + x7 +foldDigit1_9 _ _ _ _ _ _ _ x8 _ D8 = + x8 +foldDigit1_9 _ _ _ _ _ _ _ _ x9 D9 = + x9 + +instance D1 Digit1_9 where + d1 = + D1 + +instance D2 Digit1_9 where + d2 = + D2 + +instance D3 Digit1_9 where + d3 = + D3 + +instance D4 Digit1_9 where + d4 = + D4 + +instance D5 Digit1_9 where + d5 = + D5 + +instance D6 Digit1_9 where + d6 = + D6 + +instance D7 Digit1_9 where + d7 = + D7 + +instance D8 Digit1_9 where + d8 = + D8 + +instance D9 Digit1_9 where + d9 = + D9 + +-- | A prism for using @Int@ as @Digit1_9@. +-- +-- >>> 5 ^? digit1_9 +-- Just 5 +-- +-- >>> 0 ^? digit1_9 +-- Nothing +-- +-- >>> 9 ^? digit1_9 +-- Just 9 +-- +-- >>> 10 ^? digit1_9 +-- Nothing +-- +-- >>> (-5) ^? digit1_9 +-- Nothing +digit1_9 :: + Prism' Int Digit1_9 +digit1_9 = + digit . digit1_9digit + +-- | A prism for using @Char@ as @Digit1_9@. +-- +-- >>> '5' ^? digitC1_9 +-- Just 5 +-- +-- >>> '0' ^? digitC1_9 +-- Nothing +-- +-- >>> '9' ^? digitC1_9 +-- Just 9 +-- +-- >>> 'x' ^? digitC1_9 +-- Nothing +-- +-- >>> '*' ^? digitC1_9 +-- Nothing +digitC1_9 :: + Prism' Char Digit1_9 +digitC1_9 = + digitC . digit1_9digit + +-- | A prism for using @Digit@ as @Digit1_9@. +-- +-- >>> d5 ^? digit1_9digit +-- Just 5 +-- +-- >>> d0 ^? digit1_9digit +-- Nothing +-- +-- >>> d9 ^? digit1_9digit +-- Just 9 +-- +-- >>> d1 ^? digit1_9digit +-- Just 1 +digit1_9digit :: + Prism' Digit Digit1_9 +digit1_9digit = + prism' + (foldDigit1_9 + d1 + d2 + d3 + d4 + d5 + d6 + d7 + d8 + d9) + (foldDigit + Nothing + (Just D1) + (Just D2) + (Just D3) + (Just D4) + (Just D5) + (Just D6) + (Just D7) + (Just D8) + (Just D9)) + +instance Show Digit1_9 where + show d = + show (digit1_9 # d) + +instance Read Digit1_9 where + readsPrec _ ('1':t) = + [(D1, t)] + readsPrec _ ('2':t) = + [(D2, t)] + readsPrec _ ('3':t) = + [(D3, t)] + readsPrec _ ('4':t) = + [(D4, t)] + readsPrec _ ('5':t) = + [(D5, t)] + readsPrec _ ('6':t) = + [(D6, t)] + readsPrec _ ('7':t) = + [(D7, t)] + readsPrec _ ('8':t) = + [(D8, t)] + readsPrec _ ('9':t) = + [(D9, t)] + readsPrec _ _ = + [] diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,32 @@ +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