digit-0.3.0: src/Data/Digit.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | A data type with ten nullary constructors [0-9] and combinators.
module Data.Digit
(
Digit
, foldDigit
, HasDigit(..)
, AsDigit(..)
, ManyDigit(..)
, D0(..)
, D1(..)
, D2(..)
, D3(..)
, D4(..)
, D5(..)
, D6(..)
, D7(..)
, D8(..)
, D9(..)
, mod10
, absrem10
, divMod10
, parsedigit
, digitQ
, (/+/)
) where
import Data.Data (Data)
import Data.Maybe(fromMaybe)
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)
import Text.Parser.Combinators((<?>))
import Papa
-- $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, 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
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D1 == q1
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D2 == q2
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D3 == q3
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D4 == q4
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D5 == q5
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D6 == q6
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D7 == q7
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D8 == q8
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D9 == q9
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 q0 _ _ _ _ _ _ _ _ _ D0 =
q0
foldDigit _ q1 _ _ _ _ _ _ _ _ D1 =
q1
foldDigit _ _ q2 _ _ _ _ _ _ _ D2 =
q2
foldDigit _ _ _ q3 _ _ _ _ _ _ D3 =
q3
foldDigit _ _ _ _ q4 _ _ _ _ _ D4 =
q4
foldDigit _ _ _ _ _ q5 _ _ _ _ D5 =
q5
foldDigit _ _ _ _ _ _ q6 _ _ _ D6 =
q6
foldDigit _ _ _ _ _ _ _ q7 _ _ D7 =
q7
foldDigit _ _ _ _ _ _ _ _ q8 _ D8 =
q8
foldDigit _ _ _ _ _ _ _ _ _ q9 D9 =
q9
class HasDigit a where
hasdigit ::
Lens' a Digit
instance HasDigit Digit where
hasdigit =
id
class D0 d where
d0 ::
Prism'
d
()
x0 ::
D0 d =>
d
x0 =
d0 # ()
instance D0 Digit where
d0 =
prism'
(\() -> D0)
(\d -> case d of
D0 -> Just ()
_ -> Nothing)
class D1 d where
d1 ::
Prism'
d
()
x1 ::
D1 d =>
d
x1 =
d1 # ()
instance D1 Digit where
d1 =
prism'
(\() -> D1)
(\d -> case d of
D1 -> Just ()
_ -> Nothing)
class D2 d where
d2 ::
Prism'
d
()
x2 ::
D2 d =>
d
x2 =
d2 # ()
instance D2 Digit where
d2 =
prism'
(\() -> D2)
(\d -> case d of
D2 -> Just ()
_ -> Nothing)
class D3 d where
d3 ::
Prism'
d
()
x3 ::
D3 d =>
d
x3 =
d3 # ()
instance D3 Digit where
d3 =
prism'
(\() -> D3)
(\d -> case d of
D3 -> Just ()
_ -> Nothing)
class D4 d where
d4 ::
Prism'
d
()
x4 ::
D4 d =>
d
x4 =
d4 # ()
instance D4 Digit where
d4 =
prism'
(\() -> D4)
(\d -> case d of
D4 -> Just ()
_ -> Nothing)
class D5 d where
d5 ::
Prism'
d
()
x5 ::
D5 d =>
d
x5 =
d5 # ()
instance D5 Digit where
d5 =
prism'
(\() -> D5)
(\d -> case d of
D5 -> Just ()
_ -> Nothing)
class D6 d where
d6 ::
Prism'
d
()
x6 ::
D6 d =>
d
x6 =
d6 # ()
instance D6 Digit where
d6 =
prism'
(\() -> D6)
(\d -> case d of
D6 -> Just ()
_ -> Nothing)
class D7 d where
d7 ::
Prism'
d
()
x7 ::
D7 d =>
d
x7 =
d7 # ()
instance D7 Digit where
d7 =
prism'
(\() -> D7)
(\d -> case d of
D7 -> Just ()
_ -> Nothing)
class D8 d where
d8 ::
Prism'
d
()
x8 ::
D8 d =>
d
x8 =
d8 # ()
instance D8 Digit where
d8 =
prism'
(\() -> D8)
(\d -> case d of
D8 -> Just ()
_ -> Nothing)
class D9 d where
d9 ::
Prism'
d
()
x9 ::
D9 d =>
d
x9 =
d9 # ()
instance D9 Digit where
d9 =
prism'
(\() -> D9)
(\d -> case d of
D9 -> Just ()
_ -> Nothing)
class AsDigit a where
digit ::
Prism'
a
Digit
instance AsDigit Digit where
digit =
id
-- |
--
-- >>> (5 :: Int) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int
-- 5
--
-- >>> digitIntegral # D9 :: Int
-- 9
--
-- >>> digitIntegral # D0 :: Int
-- 0
instance AsDigit Int where
digit =
digitIntegral
-- |
--
-- >>> (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
-- |
--
-- >>> (5 :: Int16) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int16) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int16) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int16) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int16) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int16
-- 5
--
-- >>> digitIntegral # D9 :: Int16
-- 9
--
-- >>> 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
-- |
--
-- >>> (5 :: Int64) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int64) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int64) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int64) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int64) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int64
-- 5
--
-- >>> digitIntegral # D9 :: Int64
-- 9
--
-- >>> digitIntegral # D0 :: Int64
-- 0
instance AsDigit Int64 where
digit =
digitIntegral
-- |
--
-- >>> (5 :: Integer) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Integer) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Integer) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Integer) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Integer) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Integer
-- 5
--
-- >>> digitIntegral # D9 :: Integer
-- 9
--
-- >>> digitIntegral # D0 :: Integer
-- 0
instance AsDigit Integer where
digit =
digitIntegral
-- |
--
-- >>> (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
-- 0
--
-- >>> mod10 1
-- 1
--
-- >>> mod10 8
-- 8
--
-- >>> mod10 9
-- 9
--
-- >>> mod10 10
-- 0
--
-- >>> mod10 90
-- 0
--
-- >>> mod10 91
-- 1
--
-- >>> mod10 (-1)
-- 9
--
-- >>> mod10 (-12)
-- 8
mod10 ::
Integral a =>
a
-> Digit
mod10 n =
let r = n `mod` 10
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
-- (0,0)
--
-- >>> divMod10 1
-- (0,1)
--
-- >>> divMod10 8
-- (0,8)
--
-- >>> divMod10 9
-- (0,9)
--
-- >>> divMod10 10
-- (1,0)
--
-- >>> divMod10 90
-- (9,0)
--
-- >>> divMod10 91
-- (9,1)
--
-- >>> divMod10 (-1)
-- (-1,9)
divMod10 ::
Integral a =>
a
-> (a, Digit)
divMod10 n =
let (x, r) = n `divMod` 10
in (x, mod10 r)
parsedigit ::
CharParsing p =>
p Digit
parsedigit =
let p = asum ((\d -> d <$ char (digit # d)) <$> [D0 .. D9])
in p <?> "Digit"
-- | A QuasiQuoter for any range of @Digit@.
--
-- [digitQ|4|] :: Digit
-- 4
--
-- named [digitQ|4|] = "four"
-- named [digitQ|$x|] = "not four, " ++ show x ++ " instead"
--
-- mod10D x = let y = mod x 10 in [digitQ|$y|]
digitQ :: QuasiQuoter
digitQ = QuasiQuoter {
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"
}
-- |
--
-- >>> D0 /+/ D0
-- (0,0)
--
-- >>> D0 /+/ D1
-- (0,1)
--
-- >>> D1 /+/ D0
-- (0,1)
--
-- >>> D4 /+/ D5
-- (0,9)
--
-- >>> D5 /+/ D5
-- (1,0)
--
-- >>> D5 /+/ D6
-- (1,1)
--
-- >>> D8 /+/ D7
-- (1,5)
--
-- >>> D9 /+/ D9
-- (1,8)
(/+/) ::
Digit
-> Digit
-> (Digit, Digit)
a /+/ b =
let (x, r) = divMod10 (digitIntegral # a + digitIntegral # b)
in (mod10 (x :: Integer), r)
---- 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)