@@ -0,0 +1,138 @@
1+{- HLINT ignore unsafeDigits -}
2+{-# LANGUAGE TemplateHaskell #-}
3+
4+module Data.Digit
5+ ( Digit(..)
6+ , NormalDigits(..)
7+ , _NormalDigits
8+ , digitToChar
9+ , charToDigit
10+ , digitToNum
11+ , digitsToNum
12+ , poly10
13+ , digitFromNumMod10
14+ , natToDigits
15+ , _Digit
16+ , _Digits
17+ , _DigitsText
18+ , _DigitsInt
19+ , _DigitsNat
20+ , digitRegex
21+ , digitRegex'
22+ , unsafeDigits
23+ ) where
24+
25+import Control.Lens
26+import Control.Lens.Missing
27+import Data.Foldable as F
28+import Data.List as L
29+import Data.List.NonEmpty as NE
30+import Data.Maybe
31+import Data.Text as T
32+import Data.Text.Lens
33+import GHC.Generics (Generic)
34+import Numeric.Natural
35+import Test.QuickCheck
36+import Text.Regex.Applicative as R
37+
38+
39+-- | Decimal digit.
40+data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9
41+ deriving (Eq, Ord, Show, Enum, Bounded, Generic)
42+
43+instance Arbitrary Digit where
44+ arbitrary = arbitraryBoundedEnum
45+
46+-- | Normal form of digits, that doesn't have leading zeroes
47+newtype NormalDigits = NormalDigits
48+ { unDigits :: NonEmpty Digit
49+ } deriving (Eq, Ord, Show)
50+
51+makePrisms ''NormalDigits
52+
53+instance Arbitrary NormalDigits where
54+ arbitrary = do
55+ norm <- L.dropWhile (== D0) <$> arbitrary
56+ normNe <- case norm of
57+ [] -> pure <$> arbitrary
58+ x:xs -> pure $ x :| xs
59+ return $ NormalDigits normNe
60+
61+digitToChar :: Digit -> Char
62+digitToChar = \case
63+ D0 -> '0'
64+ D1 -> '1'
65+ D2 -> '2'
66+ D3 -> '3'
67+ D4 -> '4'
68+ D5 -> '5'
69+ D6 -> '6'
70+ D7 -> '7'
71+ D8 -> '8'
72+ D9 -> '9'
73+
74+charToDigit :: Char -> Maybe Digit
75+charToDigit = \case
76+ '0' -> Just D0
77+ '1' -> Just D1
78+ '2' -> Just D2
79+ '3' -> Just D3
80+ '4' -> Just D4
81+ '5' -> Just D5
82+ '6' -> Just D6
83+ '7' -> Just D7
84+ '8' -> Just D8
85+ '9' -> Just D9
86+ _ -> Nothing
87+
88+digitToNum :: Num n => Digit -> n
89+digitToNum = fromIntegral . fromEnum
90+
91+digitsToNum :: (Functor f, Foldable f, Num n) => f Digit -> n
92+digitsToNum = poly10 . fmap digitToNum
93+
94+poly10 :: (Num n, Foldable f) => f n -> n
95+poly10 = F.foldl' go 0
96+ where
97+ go acc n = (acc * 10) + n
98+
99+digitFromNumMod10 :: Integral n => n -> Digit
100+digitFromNumMod10 = toEnum . fromIntegral . (`mod` 10)
101+
102+-- | Convert natural number to non empty list of digits.
103+natToDigits :: Natural -> NormalDigits
104+natToDigits = NormalDigits . NE.reverse . natToDigitsRev
105+
106+natToDigitsRev :: Natural -> NE.NonEmpty Digit
107+natToDigitsRev n = if d==0 then pure digit else digit `NE.cons` natToDigitsRev d
108+ where
109+ (d, m) = n `divMod` 10
110+ digit = toEnum (fromIntegral m)
111+
112+_Digit :: Prism' Char Digit
113+_Digit = prism' digitToChar charToDigit
114+
115+_Digits :: Traversable t => Prism' (t Char) (t Digit)
116+_Digits = below _Digit
117+
118+_DigitsText :: Prism' Text (NE.NonEmpty Digit)
119+_DigitsText = from packed . _Digits . _NonEmptyList
120+
121+_DigitsInt :: Integral n => Prism' n NormalDigits
122+_DigitsInt = prism' (digitsToNum . unDigits) positiveIntToDigits
123+ where
124+ positiveIntToDigits n = if n < 0
125+ then Nothing
126+ else Just $ natToDigits (fromInteger $ fromIntegral n)
127+
128+_DigitsNat :: Iso' Natural NormalDigits
129+_DigitsNat = iso natToDigits (digitsToNum . unDigits)
130+
131+digitRegex :: RE Char Digit
132+digitRegex = R.msym charToDigit
133+
134+digitRegex' :: RE Char Char
135+digitRegex' = digitToChar <$> digitRegex
136+
137+unsafeDigits :: String -> [Digit]
138+unsafeDigits = fmap (fromJust . charToDigit)