module Data.Digit
(
Digit
, foldDigit
, D0(..)
, x0
, D1(..)
, x1
, D2(..)
, x2
, D3(..)
, x3
, D4(..)
, x4
, D5(..)
, x5
, D6(..)
, x6
, D7(..)
, x7
, D8(..)
, x8
, D9(..)
, x9
, digit
, digitC
, digitQ
) where
import Control.Category((.))
import Control.Lens(Prism', prism', (^?), ( # ))
import Data.Char(Char)
import Data.Data (Data)
import Data.Eq(Eq)
import Data.Function(const)
import Data.Int(Int)
import Data.Maybe(Maybe(Nothing, Just), maybe)
import Data.Ord(Ord)
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(Show(..), Read(..), Enum(..), Bounded, error)
data Digit =
D0
| D1
| D2
| D3
| D4
| D5
| D6
| D7
| D8
| D9
deriving (Eq, Ord, Enum, Bounded, Data, Typeable)
foldDigit ::
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> Digit
-> 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 D0 d where
d0 ::
Prism'
d
()
instance D0 Digit where
d0 =
prism'
(\() -> D0)
(\d -> case d of
D0 -> Just ()
_ -> Nothing)
x0 ::
D0 d =>
d
x0 =
d0 # ()
class D1 d where
d1 ::
Prism'
d
()
instance D1 Digit where
d1 =
prism'
(\() -> D1)
(\d -> case d of
D1 -> Just ()
_ -> Nothing)
x1 ::
D1 d =>
d
x1 =
d1 # ()
class D2 d where
d2 ::
Prism'
d
()
instance D2 Digit where
d2 =
prism'
(\() -> D2)
(\d -> case d of
D2 -> Just ()
_ -> Nothing)
x2 ::
D2 d =>
d
x2 =
d2 # ()
class D3 d where
d3 ::
Prism'
d
()
instance D3 Digit where
d3 =
prism'
(\() -> D3)
(\d -> case d of
D3 -> Just ()
_ -> Nothing)
x3 ::
D3 d =>
d
x3 =
d3 # ()
class D4 d where
d4 ::
Prism'
d
()
instance D4 Digit where
d4 =
prism'
(\() -> D4)
(\d -> case d of
D4 -> Just ()
_ -> Nothing)
x4 ::
D4 d =>
d
x4 =
d4 # ()
class D5 d where
d5 ::
Prism'
d
()
instance D5 Digit where
d5 =
prism'
(\() -> D5)
(\d -> case d of
D5 -> Just ()
_ -> Nothing)
x5 ::
D5 d =>
d
x5 =
d5 # ()
class D6 d where
d6 ::
Prism'
d
()
instance D6 Digit where
d6 =
prism'
(\() -> D6)
(\d -> case d of
D6 -> Just ()
_ -> Nothing)
x6 ::
D6 d =>
d
x6 =
d6 # ()
class D7 d where
d7 ::
Prism'
d
()
instance D7 Digit where
d7 =
prism'
(\() -> D7)
(\d -> case d of
D7 -> Just ()
_ -> Nothing)
x7 ::
D7 d =>
d
x7 =
d7 # ()
class D8 d where
d8 ::
Prism'
d
()
instance D8 Digit where
d8 =
prism'
(\() -> D8)
(\d -> case d of
D8 -> Just ()
_ -> Nothing)
x8 ::
D8 d =>
d
x8 =
d8 # ()
class D9 d where
d9 ::
Prism'
d
()
instance D9 Digit where
d9 =
prism'
(\() -> D9)
(\d -> case d of
D9 -> Just ()
_ -> Nothing)
x9 ::
D9 d =>
d
x9 =
d9 # ()
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)
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)
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 _ _ =
[]
digitQ :: QuasiQuoter
digitQ = QuasiQuoter {
quoteExp = dexp
, quotePat = 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"