First commit

LICENSE

@@ -0,0 +1,2 @@
+Copyright © 2020, Antorica LLC
+All rights reserved

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

digit.cabal

@@ -0,0 +1,36 @@
+cabal-version:       2.4
+name:                digit
+version:             0.1.0.0
+synopsis: Decimal digit
+license-file:        LICENSE
+build-type:          Simple
+
+library
+  hs-source-dirs:      src
+  ghc-options:         -Wall
+  exposed-modules:     Data.Digit
+  build-depends:       base
+                     , QuickCheck
+                     , lens
+                     , missing-lens
+                     , regex-applicative
+                     , text
+  default-language:    Haskell2010
+  default-extensions:  DeriveGeneric
+                     , LambdaCase
+
+test-suite spec
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      spec
+  main-is:             Spec.hs
+  default-language:    Haskell2010
+  build-depends:       base
+                     , QuickCheck
+                     , quickcheck-instances
+                     , digit
+                     , lens
+                     , hspec
+  build-tool-depends:  hspec-discover:hspec-discover
+  other-modules:       DigitSpec
+  default-extensions:  RankNTypes
+                     , TypeApplications

spec/DigitSpec.hs

@@ -0,0 +1,34 @@
+module DigitSpec (spec) where
+
+import Data.Digit
+import Control.Lens
+import Test.Hspec
+import Test.QuickCheck
+import Test.QuickCheck.Instances ()
+
+
+spec :: Spec
+spec = describe "Digit" $ do
+  specify "_Digit" $ property (prop_Prism _Digit)
+  specify "_Digits" $ property (prop_Prism (_Digits @[]))
+  specify "_DigitsText" $ property (prop_Prism _DigitsText)
+  specify "_DigitsInt" $ property (prop_Prism (_DigitsInt @Integer))
+  specify "_DigitsNat" $ property (prop_Iso _DigitsNat)
+
+prop_Prism :: (Eq a, Eq s) => Prism' s a -> s -> a -> Bool
+prop_Prism p s a = prop_PrismTo p s && prop_PrismRe p a
+
+prop_PrismRe :: Eq a => Prism' s a -> a -> Bool
+prop_PrismRe p a = preview (re p . p) a == Just a
+
+prop_PrismTo :: Eq s => Prism' s a -> s -> Bool
+prop_PrismTo p s = maybe True (== s) (s ^? p . re p)
+
+prop_Iso :: (Eq a, Eq s) => Iso' s a -> s -> a -> Bool
+prop_Iso i s a = prop_IsoTo i s && prop_IsoRe i a
+
+prop_IsoRe :: Eq a => Iso' s a -> a -> Bool
+prop_IsoRe i a = view (re i . i) a == a
+
+prop_IsoTo :: Eq s => Iso' s a -> s -> Bool
+prop_IsoTo i s = view (i . re i) s == s

spec/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

src/Data/Digit.hs

@@ -0,0 +1,138 @@
+{- HLINT ignore unsafeDigits -}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.Digit
+  ( Digit(..)
+  , NormalDigits(..)
+  , _NormalDigits
+  , digitToChar
+  , charToDigit
+  , digitToNum
+  , digitsToNum
+  , poly10
+  , digitFromNumMod10
+  , natToDigits
+  , _Digit
+  , _Digits
+  , _DigitsText
+  , _DigitsInt
+  , _DigitsNat
+  , digitRegex
+  , digitRegex'
+  , unsafeDigits
+  ) where
+
+import Control.Lens
+import Control.Lens.Missing
+import Data.Foldable as F
+import Data.List as L
+import Data.List.NonEmpty as NE
+import Data.Maybe
+import Data.Text as T
+import Data.Text.Lens
+import GHC.Generics (Generic)
+import Numeric.Natural
+import Test.QuickCheck
+import Text.Regex.Applicative as R
+
+
+-- | Decimal digit.
+data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9
+  deriving (Eq, Ord, Show, Enum, Bounded, Generic)
+
+instance Arbitrary Digit where
+  arbitrary = arbitraryBoundedEnum
+
+-- | Normal form of digits, that doesn't have leading zeroes
+newtype NormalDigits = NormalDigits
+  { unDigits :: NonEmpty Digit
+  } deriving (Eq, Ord, Show)
+
+makePrisms ''NormalDigits
+
+instance Arbitrary NormalDigits where
+  arbitrary = do
+    norm <- L.dropWhile (== D0) <$> arbitrary
+    normNe <- case norm of
+      []   -> pure <$> arbitrary
+      x:xs -> pure $ x :| xs
+    return $ NormalDigits normNe
+
+digitToChar :: Digit -> Char
+digitToChar = \case
+  D0 -> '0'
+  D1 -> '1'
+  D2 -> '2'
+  D3 -> '3'
+  D4 -> '4'
+  D5 -> '5'
+  D6 -> '6'
+  D7 -> '7'
+  D8 -> '8'
+  D9 -> '9'
+
+charToDigit :: Char -> Maybe Digit
+charToDigit = \case
+  '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
+
+digitToNum :: Num n => Digit -> n
+digitToNum = fromIntegral . fromEnum
+
+digitsToNum :: (Functor f, Foldable f, Num n) => f Digit -> n
+digitsToNum = poly10 . fmap digitToNum
+
+poly10 :: (Num n, Foldable f) => f n -> n
+poly10 = F.foldl' go 0
+  where
+    go acc n = (acc * 10) + n
+
+digitFromNumMod10 :: Integral n => n -> Digit
+digitFromNumMod10 = toEnum . fromIntegral . (`mod` 10)
+
+-- | Convert natural number to non empty list of digits.
+natToDigits :: Natural -> NormalDigits
+natToDigits = NormalDigits . NE.reverse . natToDigitsRev
+
+natToDigitsRev :: Natural -> NE.NonEmpty Digit
+natToDigitsRev n = if d==0 then pure digit else digit `NE.cons` natToDigitsRev d
+  where
+    (d, m) = n `divMod` 10
+    digit  = toEnum (fromIntegral m)
+
+_Digit :: Prism' Char Digit
+_Digit = prism' digitToChar charToDigit
+
+_Digits :: Traversable t => Prism' (t Char) (t Digit)
+_Digits = below _Digit
+
+_DigitsText :: Prism' Text (NE.NonEmpty Digit)
+_DigitsText = from packed . _Digits . _NonEmptyList
+
+_DigitsInt :: Integral n => Prism' n NormalDigits
+_DigitsInt = prism' (digitsToNum . unDigits) positiveIntToDigits
+  where
+    positiveIntToDigits n = if n < 0
+      then Nothing
+      else Just $ natToDigits (fromInteger $ fromIntegral n)
+
+_DigitsNat :: Iso' Natural NormalDigits
+_DigitsNat = iso natToDigits (digitsToNum . unDigits)
+
+digitRegex :: RE Char Digit
+digitRegex = R.msym charToDigit
+
+digitRegex' :: RE Char Char
+digitRegex' = digitToChar <$> digitRegex
+
+unsafeDigits :: String -> [Digit]
+unsafeDigits = fmap (fromJust . charToDigit)