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
, digits
, mod10
, divMod10
, parsedigit
, parsedigits
, parsedigits1
, skipdigits
, skipdigits1
, parsenotdigit
, parsenotdigits
, parsenotdigits1
, skipnotdigits
, skipnotdigits1
, digitQ
) where
import Control.Applicative(many, some)
import Control.Category((.))
import Control.Lens(Prism', prism', (^?), ( # ))
import Control.Monad(Monad)
import Data.Char(Char)
import Data.Data (Data)
import Data.Eq(Eq((==)))
import Data.Foldable(foldl', asum)
import Data.Function(const)
import Data.Functor((<$), (<$>))
import Data.Int(Int)
import Data.List(unfoldr, reverse, notElem)
import Data.List.NonEmpty(NonEmpty, some1)
import Data.Maybe(Maybe(Nothing, Just), maybe, fromMaybe)
import Data.Ord(Ord((<)))
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(Show(..), Read(..), Enum(..), Bounded, Num(..), error, divMod, mod)
import Text.Parser.Char(CharParsing, char, satisfy)
import Text.Parser.Combinators(skipMany, skipSome, (<?>))
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)
digits ::
Prism'
Int
[Digit]
digits =
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))
)
mod10 ::
Int
-> Digit
mod10 n =
let r = n `mod` 10
in fromMaybe (mod10 r) (r ^? digit)
divMod10 ::
Int
-> (Int, Digit)
divMod10 n =
let (x, r) = n `divMod` 10
in (x, mod10 r)
parsedigit ::
(Monad p, CharParsing p) =>
p Digit
parsedigit =
let p = asum ((\d -> d <$ char (digitC # d)) <$> [D0 .. D9])
in p <?> "digit"
parsedigits ::
(Monad p, CharParsing p) =>
p [Digit]
parsedigits =
many parsedigit
parsedigits1 ::
(Monad p, CharParsing p) =>
p (NonEmpty Digit)
parsedigits1 =
some1 parsedigit
skipdigits ::
(Monad p, CharParsing p) =>
p ()
skipdigits =
skipMany parsedigit
skipdigits1 ::
(Monad p, CharParsing p) =>
p ()
skipdigits1 =
skipSome parsedigit
parsenotdigit ::
(Monad p, CharParsing p) =>
p Char
parsenotdigit =
let p = satisfy (`notElem` ['0' .. '9'])
in p <?> "not digit"
parsenotdigits ::
(Monad p, CharParsing p) =>
p String
parsenotdigits =
many parsenotdigit
parsenotdigits1 ::
(Monad p, CharParsing p) =>
p String
parsenotdigits1 =
some parsenotdigit
skipnotdigits ::
(Monad p, CharParsing p) =>
p ()
skipnotdigits =
skipMany parsenotdigit
skipnotdigits1 ::
(Monad p, CharParsing p) =>
p ()
skipnotdigits1 =
skipSome parsenotdigit
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"