diff --git a/CONTRIBUTORS b/CONTRIBUTORS new file mode 100644 --- /dev/null +++ b/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/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -0,0 +1,32 @@ +Copyright (C) 2010-2016 NICTA Limited +Copyright (c) 2017, Commonwealth Scientific and Industrial Research Organisation +(CSIRO) ABN 41 687 119 230. + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of QFPL nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER 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/digit.cabal b/digit.cabal --- a/digit.cabal +++ b/digit.cabal @@ -1,25 +1,26 @@ name: digit -version: 0.2.9 +version: 0.3.0 license: BSD3 -license-File: etc/LICENCE -author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> -maintainer: Tony Morris +license-file: LICENCE +author: Queensland Functional Programming Lab +maintainer: Queensland Functional Programming Lab copyright: Copyright (C) 2010-2016 NICTA Limited +copyright: Copyright (c) 2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. 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 +homepage: https://github.com/qfpl/digit +bug-reports: https://github.com/qfpl/digit/issues cabal-version: >= 1.10 build-type: Custom -extra-source-files: etc/CONTRIBUTORS, changelog.md +extra-source-files: CONTRIBUTORS, changelog.md 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 + location: git@github.com:qfpl/digit.git flag small_base description: Choose the new, split-up base package. @@ -29,12 +30,12 @@ Haskell2010 build-depends: - base < 5 && >= 4.8 - , lens >= 4.3.3 && < 5.0 - , parsers >= 0.12.3 && < 0.13 - , semigroups >= 0.12 && < 1.0 - , template-haskell >= 2.8 - , papa + base >= 4.7 && < 5 + , lens >= 4.0 && < 5 + , parsers >= 0.12.3 && < 0.13 + , semigroups >= 0.12 && < 1.0 + , template-haskell >= 2.8 && < 3 + , papa >= 0.3 && < 0.4 ghc-options: -Wall @@ -44,6 +45,8 @@ exposed-modules: Data.Digit + Data.Digits + Data.Digits1 test-suite doctests type: @@ -63,6 +66,7 @@ , QuickCheck >= 2.0 , template-haskell >= 2.8 , parsec >= 3.1 + ghc-options: -Wall -threaded diff --git a/etc/CONTRIBUTORS b/etc/CONTRIBUTORS deleted file mode 100644 --- a/etc/CONTRIBUTORS +++ /dev/null @@ -1,33 +0,0 @@ -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 deleted file mode 100644 --- a/etc/LICENCE +++ /dev/null @@ -1,27 +0,0 @@ -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 --- a/src/Data/Digit.hs +++ b/src/Data/Digit.hs @@ -4,83 +4,42 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE NoImplicitPrelude #-} -- | A data type with ten nullary constructors [0-9] and combinators. module Data.Digit ( --- * Data type Digit --- * Destructors , foldDigit --- * Lenses , HasDigit(..) --- * Prisms +, AsDigit(..) +, ManyDigit(..) , D0(..) -, x0 , D1(..) -, x1 , D2(..) -, x2 , D3(..) -, x3 , D4(..) -, x4 , D5(..) -, x5 , D6(..) -, x6 , D7(..) -, x7 , D8(..) -, x8 , D9(..) -, x9 -, digit -, digitC -, digitlist --- * mod operations , mod10 +, absrem10 , divMod10 --- * Parsers , parsedigit -, parsedigitlist -, parsedigits -, parsedigitlist1 -, skipdigitlist -, skipdigitlist1 -, parsenotdigit -, parsenotdigits -, parsenotdigits1 -, skipnotdigits -, skipnotdigits1 --- * Quasi-Quoters , digitQ --- * Digits -, Digits -, digits -, digitsI -, digitsS , (/+/) -, (.+.) -, (.*.) -, mantissa ) where -import Control.Applicative(many, some) import Data.Data (Data) -import Data.Foldable(foldl', asum) -import Data.List(unfoldr) -import Data.List.NonEmpty(some1) import Data.Maybe(fromMaybe) -import Data.Monoid(mappend) -import Data.Semigroup((<>)) -import Data.String(String) import Data.Typeable (Typeable) import Language.Haskell.TH(ExpQ, PatQ, varE, varP, mkName) import Language.Haskell.TH.Quote(QuasiQuoter(QuasiQuoter), quotePat, quoteExp, quoteDec, dataToExpQ, dataToPatQ, quoteType) import Prelude(fromEnum, Bounded, error) -- livin on the edge -import Text.Parser.Char(CharParsing, char, satisfy) -import Text.Parser.Combinators(skipMany, skipSome, ()) +import Text.Parser.Char(CharParsing, char) +import Text.Parser.Combinators(()) import Papa -- $setup @@ -100,6 +59,10 @@ | D9 deriving (Eq, Ord, Enum, Bounded, Data, Typeable) +instance Show Digit where + show = + show . fromEnum + -- | Catamorphism for @Digit@. -- -- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D0 == q0 @@ -168,6 +131,11 @@ Prism' d () + x0 :: + D0 d => + d + x0 = + d0 # () instance D0 Digit where d0 = @@ -177,17 +145,16 @@ D0 -> Just () _ -> Nothing) -x0 :: - D0 d => - d -x0 = - d0 # () - class D1 d where d1 :: Prism' d () + x1 :: + D1 d => + d + x1 = + d1 # () instance D1 Digit where d1 = @@ -197,17 +164,16 @@ D1 -> Just () _ -> Nothing) -x1 :: - D1 d => - d -x1 = - d1 # () - class D2 d where d2 :: Prism' d () + x2 :: + D2 d => + d + x2 = + d2 # () instance D2 Digit where d2 = @@ -217,17 +183,16 @@ D2 -> Just () _ -> Nothing) -x2 :: - D2 d => - d -x2 = - d2 # () - class D3 d where d3 :: Prism' d () + x3 :: + D3 d => + d + x3 = + d3 # () instance D3 Digit where d3 = @@ -237,17 +202,16 @@ D3 -> Just () _ -> Nothing) -x3 :: - D3 d => - d -x3 = - d3 # () - class D4 d where d4 :: Prism' d () + x4 :: + D4 d => + d + x4 = + d4 # () instance D4 Digit where d4 = @@ -257,17 +221,16 @@ D4 -> Just () _ -> Nothing) -x4 :: - D4 d => - d -x4 = - d4 # () - class D5 d where d5 :: Prism' d () + x5 :: + D5 d => + d + x5 = + d5 # () instance D5 Digit where d5 = @@ -277,17 +240,16 @@ D5 -> Just () _ -> Nothing) -x5 :: - D5 d => - d -x5 = - d5 # () - class D6 d where d6 :: Prism' d () + x6 :: + D6 d => + d + x6 = + d6 # () instance D6 Digit where d6 = @@ -297,17 +259,16 @@ D6 -> Just () _ -> Nothing) -x6 :: - D6 d => - d -x6 = - d6 # () - class D7 d where d7 :: Prism' d () + x7 :: + D7 d => + d + x7 = + d7 # () instance D7 Digit where d7 = @@ -317,17 +278,16 @@ D7 -> Just () _ -> Nothing) -x7 :: - D7 d => - d -x7 = - d7 # () - class D8 d where d8 :: Prism' d () + x8 :: + D8 d => + d + x8 = + d8 # () instance D8 Digit where d8 = @@ -337,17 +297,16 @@ D8 -> Just () _ -> Nothing) -x8 :: - D8 d => - d -x8 = - d8 # () - class D9 d where d9 :: Prism' d () + x9 :: + D9 d => + d + x9 = + d9 # () instance D9 Digit where d9 = @@ -357,189 +316,337 @@ D9 -> Just () _ -> Nothing) -x9 :: - D9 d => - d -x9 = - d9 # () +class AsDigit a where + digit :: + Prism' + a + Digit --- | A prism for using @Int@ as @Digit@. +instance AsDigit Digit where + digit = + id + +-- | -- --- >>> 5 ^? digit +-- >>> (5 :: Int) ^? digitIntegral -- Just 5 -- --- >>> 0 ^? digit +-- >>> (0 :: Int) ^? digitIntegral -- Just 0 -- --- >>> 9 ^? digit +-- >>> (9 :: Int) ^? digitIntegral -- Just 9 -- --- >>> 10 ^? digit +-- >>> (10 :: Int) ^? digitIntegral -- Nothing -- --- >>> (-5) ^? digit +-- >>> ((-5) :: Int) ^? digitIntegral -- Nothing -- --- >>> digit # D5 +-- >>> digitIntegral # D5 :: Int -- 5 -- --- >>> digit # D9 +-- >>> digitIntegral # D9 :: Int -- 9 -- --- >>> digit # D0 +-- >>> digitIntegral # D0 :: Int -- 0 -digit :: - Integral a => - Prism' a Digit -digit = - prism' - (\n -> case n of D0 -> 0 - D1 -> 1 - D2 -> 2 - D3 -> 3 - D4 -> 4 - D5 -> 5 - D6 -> 6 - D7 -> 7 - D8 -> 8 - D9 -> 9) +instance AsDigit Int where + digit = + digitIntegral - (\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) +-- | +-- +-- >>> (5 :: Int8) ^? digitIntegral +-- Just 5 +-- +-- >>> (0 :: Int8) ^? digitIntegral +-- Just 0 +-- +-- >>> (9 :: Int8) ^? digitIntegral +-- Just 9 +-- +-- >>> (10 :: Int8) ^? digitIntegral +-- Nothing +-- +-- >>> ((-5) :: Int8) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Int8 +-- 5 +-- +-- >>> digitIntegral # D9 :: Int8 +-- 9 +-- +-- >>> digitIntegral # D0 :: Int8 +-- 0 +instance AsDigit Int8 where + digit = + digitIntegral --- | A prism for using @Char@ as @Digit@. +-- | -- --- >>> '5' ^? digitC +-- >>> (5 :: Int16) ^? digitIntegral -- Just 5 -- --- >>> '0' ^? digitC +-- >>> (0 :: Int16) ^? digitIntegral -- Just 0 -- --- >>> '9' ^? digitC +-- >>> (9 :: Int16) ^? digitIntegral -- Just 9 -- --- >>> 'a' ^? digitC +-- >>> (10 :: Int16) ^? digitIntegral -- Nothing -- --- >>> '@' ^? digitC +-- >>> ((-5) :: Int16) ^? digitIntegral -- Nothing -- --- >>> digitC # D5 --- '5' +-- >>> digitIntegral # D5 :: Int16 +-- 5 -- --- >>> digitC # D9 --- '9' +-- >>> digitIntegral # D9 :: Int16 +-- 9 -- --- >>> digitC # D0 --- '0' -digitC :: - Prism' Char Digit -digitC = - prism' - (\d -> case d of D0 -> '0' - D1 -> '1' - D2 -> '2' - D3 -> '3' - D4 -> '4' - D5 -> '5' - D6 -> '6' - D7 -> '7' - D8 -> '8' - D9 -> '9') - (\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) +-- >>> digitIntegral # D0 :: Int16 +-- 0 +instance AsDigit Int16 where + digit = + digitIntegral + +-- | +-- +-- >>> (5 :: Int32) ^? digitIntegral +-- Just 5 +-- +-- >>> (0 :: Int32) ^? digitIntegral +-- Just 0 +-- +-- >>> (9 :: Int32) ^? digitIntegral +-- Just 9 +-- +-- >>> (10 :: Int32) ^? digitIntegral +-- Nothing +-- +-- >>> ((-5) :: Int32) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Int32 +-- 5 +-- +-- >>> digitIntegral # D9 :: Int32 +-- 9 +-- +-- >>> digitIntegral # D0 :: Int32 +-- 0 +instance AsDigit Int32 where + digit = + digitIntegral --- | A prism for the list of digits in an integer +-- | -- --- >>> 1234 ^? digitlist --- Just [1,2,3,4] --- --- >>> 0 ^? digitlist --- Just [] --- --- >>> 1 ^? digitlist --- Just [1] --- --- >>> 90 ^? digitlist --- Just [9,0] --- --- >>> 05 ^? digitlist --- Just [5] --- --- >>> 105 ^? digitlist --- Just [1,0,5] --- --- >>> (-1) ^? digitlist +-- >>> (5 :: Int64) ^? digitIntegral +-- Just 5 +-- +-- >>> (0 :: Int64) ^? digitIntegral +-- Just 0 +-- +-- >>> (9 :: Int64) ^? digitIntegral +-- Just 9 +-- +-- >>> (10 :: Int64) ^? digitIntegral -- Nothing -- --- λ> digitlist # [D0] +-- >>> ((-5) :: Int64) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Int64 +-- 5 +-- +-- >>> digitIntegral # D9 :: Int64 +-- 9 +-- +-- >>> digitIntegral # D0 :: Int64 -- 0 +instance AsDigit Int64 where + digit = + digitIntegral + +-- | -- --- >>> digitlist # [D0, D1] --- 1 +-- >>> (5 :: Integer) ^? digitIntegral +-- Just 5 -- --- >>> digitlist # [D1] --- 1 +-- >>> (0 :: Integer) ^? digitIntegral +-- Just 0 -- --- >>> digitlist # [D1, D2, D3] --- 123 +-- >>> (9 :: Integer) ^? digitIntegral +-- Just 9 -- --- >>> digitlist # [D1, D0, D3] --- 103 +-- >>> (10 :: Integer) ^? digitIntegral +-- Nothing -- --- >>> digitlist # [D1, D0, D3, D0] --- 1030 -digitlist :: - Integral a => - Prism' - a - [Digit] -digitlist = - prism' - (foldl' (\a b -> a * 10 + digit # b) 0) - (\i -> if i < 0 - then - Nothing - else - Just (reverse (unfoldr (\n -> - let (x, r) = divMod10 n - in if x == 0 - then - if r == D0 - then - Nothing - else - Just (r, 0) - else - Just (r, x)) i)) - ) +-- >>> ((-5) :: Integer) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Integer +-- 5 +-- +-- >>> digitIntegral # D9 :: Integer +-- 9 +-- +-- >>> digitIntegral # D0 :: Integer +-- 0 +instance AsDigit Integer where + digit = + digitIntegral -digits :: - Integral a => - Prism' - a - Digits -digits = - digitlist . digitsI +-- | +-- +-- >>> (5 :: Identity Int) ^? digitIntegral +-- Just 5 +-- +-- >>> (0 :: Identity Int) ^? digitIntegral +-- Just 0 +-- +-- >>> (9 :: Identity Int) ^? digitIntegral +-- Just 9 +-- +-- >>> (10 :: Identity Int) ^? digitIntegral +-- Nothing +-- +-- >>> ((-5) :: Identity Int) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Identity Int +-- Identity 5 +-- +-- >>> digitIntegral # D9 :: Identity Int +-- Identity 9 +-- +-- >>> digitIntegral # D0 :: Identity Int +-- Identity 0 +instance Integral a => AsDigit (Identity a) where + digit = + digitIntegral +-- | +-- +-- >>> (5 :: Const Int String) ^? digitIntegral +-- Just 5 +-- +-- >>> (0 :: Const Int String) ^? digitIntegral +-- Just 0 +-- +-- >>> (9 :: Const Int String) ^? digitIntegral +-- Just 9 +-- +-- >>> (10 :: Const Int String) ^? digitIntegral +-- Nothing +-- +-- >>> ((-5) :: Const Int String) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Const Int String +-- Const 5 +-- +-- >>> digitIntegral # D9 :: Const Int String +-- Const 9 +-- +-- >>> digitIntegral # D0 :: Const Int String +-- Const 0 +instance Integral a => AsDigit (Const a b) where + digit = + digitIntegral + +-- | +-- +-- >>> (5 :: Word) ^? digitIntegral +-- Just 5 +-- +-- >>> (0 :: Word) ^? digitIntegral +-- Just 0 +-- +-- >>> (9 :: Word) ^? digitIntegral +-- Just 9 +-- +-- >>> (10 :: Word) ^? digitIntegral +-- Nothing +-- +-- >>> ((-5) :: Word) ^? digitIntegral +-- Nothing +-- +-- >>> digitIntegral # D5 :: Word +-- 5 +-- +-- >>> digitIntegral # D9 :: Word +-- 9 +-- +-- >>> digitIntegral # D0 :: Word +-- 0 +instance AsDigit Word where + digit = + digitIntegral + +-- | +-- +-- >>> '5' ^? digit +-- Just 5 +-- +-- >>> '0' ^? digit +-- Just 0 +-- +-- >>> '9' ^? digit +-- Just 9 +-- +-- >>> 'a' ^? digit +-- Nothing +-- +-- >>> '@' ^? digit +-- Nothing +-- +-- >>> digit # D5 :: Char +-- '5' +-- +-- >>> digit # D9 :: Char +-- '9' +-- +-- >>> digit # D0 :: Char +-- '0' +instance AsDigit Char where + digit = + prism' + (\d -> case d of D0 -> '0' + D1 -> '1' + D2 -> '2' + D3 -> '3' + D4 -> '4' + D5 -> '5' + D6 -> '6' + D7 -> '7' + D8 -> '8' + D9 -> '9') + (\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) + +class ManyDigit a where + digitT :: + Traversal' + a + Digit + +instance ManyDigit Digit where + digitT = + id + -- | Modulus with 10. -- -- >>> mod10 0 @@ -565,14 +672,53 @@ -- -- >>> mod10 (-1) -- 9 +-- +-- >>> mod10 (-12) +-- 8 mod10 :: Integral a => a -> Digit mod10 n = let r = n `mod` 10 - in fromMaybe (mod10 r) (r ^? digit) + in fromMaybe (mod10 r) (r ^? digitIntegral) +-- | Absolute value of remainder 10. +-- +-- >>> absrem10 0 +-- 0 +-- +-- >>> absrem10 1 +-- 1 +-- +-- >>> absrem10 8 +-- 8 +-- +-- >>> absrem10 9 +-- 9 +-- +-- >>> absrem10 10 +-- 0 +-- +-- >>> absrem10 90 +-- 0 +-- +-- >>> absrem10 91 +-- 1 +-- +-- >>> absrem10 (-1) +-- 1 +-- +-- >>> absrem10 (-12) +-- 2 +absrem10 :: + Integral a => + a + -> Digit +absrem10 n = + let r = abs n `rem` 10 + in fromMaybe (absrem10 r) (r ^? digitIntegral) + -- | Division/modulus with 10. -- -- >>> divMod10 0 @@ -607,75 +753,11 @@ in (x, mod10 r) parsedigit :: - (Monad p, CharParsing p) => + CharParsing p => p Digit parsedigit = - let p = asum ((\d -> d <$ char (digitC # d)) <$> [D0 .. D9]) - in p "digit" - -parsedigitlist :: - (Monad p, CharParsing p) => - p [Digit] -parsedigitlist = - many parsedigit - -parsedigits :: - (Monad p, CharParsing p) => - p Digits -parsedigits = - Digits <$> parsedigitlist - -parsedigitlist1 :: - (Monad p, CharParsing p) => - p (NonEmpty Digit) -parsedigitlist1 = - some1 parsedigit - -skipdigitlist :: - (Monad p, CharParsing p) => - p () -skipdigitlist = - skipMany parsedigit - -skipdigitlist1 :: - (Monad p, CharParsing p) => - p () -skipdigitlist1 = - skipSome parsedigit - -parsenotdigit :: - CharParsing p => - p Char -parsenotdigit = - let p = satisfy (`notElem` ['0' .. '9']) - in p "not digit" - -parsenotdigits :: - CharParsing p => - p String -parsenotdigits = - many parsenotdigit - -parsenotdigits1 :: - CharParsing p => - p String -parsenotdigits1 = - some parsenotdigit - -skipnotdigits :: - CharParsing p => - p () -skipnotdigits = - skipMany parsenotdigit - -skipnotdigits1 :: - CharParsing p => - p () -skipnotdigits1 = - skipSome parsenotdigit - -instance Show Digit where - show = show . fromEnum + let p = asum ((\d -> d <$ char (digit # d)) <$> [D0 .. D9]) + in p "Digit" -- | A QuasiQuoter for any range of @Digit@. -- @@ -688,99 +770,32 @@ -- mod10D x = let y = mod x 10 in [digitQ|$y|] digitQ :: QuasiQuoter digitQ = QuasiQuoter { - quoteExp = dexp - , quotePat = dpat - , quoteType = error "not quotable" - , quoteDec = error "not quotable" + quoteExp = let dexp :: + [Char] + -> ExpQ + dexp ('$':vn) = + varE (mkName vn) + dexp (d:[]) = + maybe (error "not a digit") (dataToExpQ (const Nothing)) (d ^? digit) + dexp _ = + error "not a digit" + in dexp + , quotePat = let dpat :: + [Char] + -> PatQ + dpat ('$':vn) = + varP (mkName vn) + dpat (d:[]) = + maybe (error "not a digit") (dataToPatQ (const Nothing)) (d ^? digit) + dpat _ = + error "not a digit" + in dpat + , quoteType = + error "not quotable" + , quoteDec = + error "not quotable" } -dexp :: [Char] -> ExpQ -dexp ('$':vn) = varE (mkName vn) -dexp (d:[]) = maybe (error "not a digit") (dataToExpQ (const Nothing)) (d ^? digitC) -dexp _ = error "not a digit" - -dpat :: [Char] -> PatQ -dpat ('$':vn) = varP (mkName vn) -dpat (d:[]) = maybe (error "not a digit") (dataToPatQ (const Nothing)) (d ^? digitC) -dpat _ = error "not a digit" - -newtype Digits = - Digits [Digit] - deriving (Eq, Ord, Show, Data, Typeable) - -digitsI :: - Iso' - [Digit] - Digits -digitsI = - iso - Digits - (\(Digits x) -> x) - -digitsS :: - Prism' - String - Digits -digitsS = - prism' - (\(Digits d) -> (digitC #) <$> d) - (\s -> Digits <$> traverse (^? digitC) s) - -instance Cons Digits Digits Digit Digit where - _Cons = - prism' - (\(h, Digits t) -> Digits (h:t)) - (\(Digits d) -> case d of - [] -> - Nothing - (h:t) -> - Just (h, Digits t)) - - -instance Snoc Digits Digits Digit Digit where - _Snoc = - prism' - (\(Digits t, z) -> Digits (t ++ [z])) - (\(Digits d) -> (\(a, b) -> (Digits a, b)) <$> d ^? _Snoc) - -instance AsEmpty Digits where - _Empty = - prism' - (\() -> Digits []) - (\(Digits d) -> case d of - [] -> - Just () - (_:_) -> - Nothing) - -instance Each Digits Digits Digit Digit where - each f (Digits d) = - Digits <$> each f d - -type instance IxValue Digits = Digit -type instance Index Digits = Int -instance Ixed Digits where - ix i f (Digits d) = - Digits <$> ix i f d - -instance Plated Digits where - plate f (Digits d) = - Digits <$> plate (\x -> (\(Digits e) -> e) <$> f (Digits x)) d - -instance Reversing Digits where - reversing (Digits d) = - Digits (reversing d) - -instance Semigroup Digits where - Digits d <> Digits e = - Digits (d <> e) - -instance Monoid Digits where - mempty = - Digits mempty - mappend = - (<>) - -- | -- -- >>> D0 /+/ D0 @@ -811,57 +826,33 @@ -> Digit -> (Digit, Digit) a /+/ b = - let (x, r) = divMod10 (digit # a + digit # b) + let (x, r) = divMod10 (digitIntegral # a + digitIntegral # b) in (mod10 (x :: Integer), r) --- | --- --- --- >>> Digits [x2] .+. Digits [x1, x0] --- Digits [1,2] --- --- >>> Digits [x1, x2, x3] .+. Digits [x4, x5, x6] --- Digits [5,7,9] -(.+.) :: - Digits - -> Digits - -> Digits -d .+. e = - fromMaybe mempty ((digits # d + digits # e :: Integer) ^? digits) - --- | --- --- --- >>> Digits [x2] .*. Digits [x1, x0] --- Digits [2,0] --- --- >>> Digits [x1, x2, x3] .*. Digits [x4, x5, x6] --- Digits [5,6,0,8,8] -(.*.) :: - Digits - -> Digits - -> Digits -d .*. e = - fromMaybe mempty ((digits # d * digits # e :: Integer) ^? digits) - --- | --- --- >>> mantissa (Digits []) :: Double --- 0.0 --- --- > mantissa (Digits [x0]) :: Double --- 0.0 --- --- >>> mantissa (Digits [x1]) :: Double --- 0.1 --- --- >>> mantissa (Digits [x1, x9]) :: Double --- 0.19 -mantissa :: - Floating a => - Digits - -> a -mantissa d = - let acc a (e, x) = - a + fromIntegral (digit # x :: Int) * 10 ** fromIntegral (negate e :: Int) - in foldl' acc 0 (zip [1..] (digitsI # d)) +---- not exported +digitIntegral :: + Integral a => + Prism' a Digit +digitIntegral = + prism' + (\n -> case n of D0 -> 0 + D1 -> 1 + D2 -> 2 + D3 -> 3 + D4 -> 4 + D5 -> 5 + D6 -> 6 + D7 -> 7 + D8 -> 8 + D9 -> 9) + (\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) diff --git a/src/Data/Digits.hs b/src/Data/Digits.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digits.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digits( + Digits(..) +, AsDigits(..) +, HasDigits(..) +, ManyDigits(..) +, parsedigits +) where + +import Control.Applicative(many) +import Data.Data (Data) +import Data.Digit(Digit, AsDigit(..), ManyDigit(..), parsedigit) +import Data.Digits1(Digits1(..), AsDigits1(..)) +import Data.Monoid(mappend) +import Data.Semigroup((<>)) +import Data.Typeable (Typeable) +import Text.Parser.Char(CharParsing) +import Text.Parser.Combinators(()) +import Papa + +newtype Digits = + Digits + [Digit] + deriving (Eq, Ord, Show, Data, Typeable) + +makeWrapped ''Digits + +class AsDigits a where + _Digits :: + Prism' + a + Digits + +instance AsDigits Digits where + _Digits = + id + +instance AsDigit a => AsDigits [a] where + _Digits = + prism' + (\(Digits d) -> (digit #) <$> d) + (\s -> Digits <$> traverse (^? digit) s) + +class HasDigits a where + digitsL :: + Lens' + a + Digits + +instance HasDigits Digits where + digitsL = + id + +class ManyDigits a where + digitsT :: + Traversal' + a + Digits + +instance ManyDigits Digits where + digitsT = + id + +instance Cons Digits Digits Digit Digit where + _Cons = + prism' + (\(h, Digits t) -> Digits (h:t)) + (\(Digits d) -> (_2 %~ Digits) <$> d ^? _Cons) + +instance Snoc Digits Digits Digit Digit where + _Snoc = + prism' + (\(Digits t, z) -> Digits (t ++ [z])) + (\(Digits d) -> (_1 %~ Digits) <$> d ^? _Snoc) + +instance AsEmpty Digits where + _Empty = + _Wrapped . _Empty + +instance Each Digits Digits Digit Digit where + each f (Digits d) = + Digits <$> each f d + +type instance IxValue Digits = Digit +type instance Index Digits = Int +instance Ixed Digits where + ix i f (Digits d) = + Digits <$> ix i f d + +instance Plated Digits where + plate f (Digits d) = + Digits <$> plate (\x -> (\(Digits e) -> e) <$> f (Digits x)) d + +instance Reversing Digits where + reversing (Digits d) = + Digits (reversing d) + +instance Semigroup Digits where + Digits d <> Digits e = + Digits (d <> e) + +instance Monoid Digits where + mempty = + Digits mempty + mappend = + (<>) + +parsedigits :: + CharParsing p => + p Digits +parsedigits = + Digits <$> many parsedigit "Digits" + +instance AsDigits1 Digits where + _Digits1 = + prism' + (\(Digits1 x) -> Digits (toList x)) + (\(Digits x) -> case x of + [] -> + Nothing + h:t -> + Just (Digits1 (h :| t))) + +instance ManyDigit Digits where + digitT f (Digits d) = + Digits <$> traverse f d diff --git a/src/Data/Digits1.hs b/src/Data/Digits1.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digits1.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Digits1( + Digits1(..) +, AsDigits1(..) +, HasDigits1(..) +, ManyDigits1(..) +, parsedigitlist1 +) where + +import Data.Data(Data) +import Data.Digit(Digit, AsDigit(..), ManyDigit(..), parsedigit) +import Data.List.NonEmpty(some1) +import qualified Data.List.NonEmpty as NonEmpty(cons) +import Data.Semigroup((<>)) +import Data.Typeable (Typeable) +import Text.Parser.Char(CharParsing) +import Text.Parser.Combinators(()) +import Papa + +newtype Digits1 = + Digits1 + (NonEmpty Digit) + deriving (Eq, Ord, Show, Data, Typeable) + +makeWrapped ''Digits1 + +class AsDigits1 a where + _Digits1 :: + Prism' + a + Digits1 + +instance AsDigits1 Digits1 where + _Digits1 = + id + + +instance AsDigit a => AsDigits1 (NonEmpty a) where + _Digits1 = + prism' + (\(Digits1 d) -> (digit #) <$> d) + (\s -> Digits1 <$> traverse (^? digit) s) + +instance AsDigit a => AsDigits1 [a] where + _Digits1 = + -- where does this live? + let nonemptyP :: + Prism [a] [a] (NonEmpty a) (NonEmpty a) + nonemptyP = + prism' + toList + (\x -> case x of + [] -> + Nothing + h:t -> + Just (h :| t)) + in nonemptyP . _Digits1 + +class HasDigits1 a where + digits1L :: + Lens' + a + Digits1 + +instance HasDigits1 Digits1 where + digits1L = + id + +class ManyDigits1 a where + digits1T :: + Traversal' + a + Digits1 + +instance ManyDigits1 Digits1 where + digits1T = + id + +instance Semigroup Digits1 where + Digits1 x <> Digits1 y = + Digits1 (x <> y) + +instance Plated Digits1 where + plate f (Digits1 d) = + let platedNonEmpty :: + Traversal' (NonEmpty a) (NonEmpty a) + platedNonEmpty k l@(_ :| []) = + k l + platedNonEmpty k (h :| i : t) = + (h `NonEmpty.cons`) <$> k (i :| t) + in Digits1 <$> platedNonEmpty (\n -> (\(Digits1 x) -> x) <$> f (Digits1 n)) d + +instance Reversing Digits1 where + reversing (Digits1 d) = + Digits1 (reversing d) + +instance Each Digits1 Digits1 Digit Digit where + each f (Digits1 d) = + Digits1 <$> each f d + +instance Snoc Digits1 Digits1 Digit Digit where + _Snoc = + prism' + (\(Digits1 ds, d) -> Digits1 (ds <> (d :| []))) + (\(Digits1 (h :| t)) -> (_1 %~ (\ds -> Digits1 (h :| ds))) <$> t ^? _Snoc) + +instance Cons Digits1 Digits1 Digit Digit where + _Cons = + prism' + (\(d, Digits1 ds) -> Digits1 (d `NonEmpty.cons` ds)) + (\(Digits1 (h :| t)) -> (_2 %~ (\ds -> Digits1 (h :| ds))) <$> t ^? _Cons) + +type instance IxValue Digits1 = Digit +type instance Index Digits1 = Int +instance Ixed Digits1 where + ix i f (Digits1 d) = + Digits1 <$> ix i f d + +parsedigitlist1 :: + CharParsing p => + p Digits1 +parsedigitlist1 = + Digits1 <$> some1 parsedigit "Digits1" + +instance ManyDigit Digits1 where + digitT f (Digits1 d) = + Digits1 <$> traverse f d