commit e03f087c90c9228a9ae52a0e516eba22589eef94 Author: Vladislav Date: Wed Mar 23 09:39:24 2022 +0400 First commit diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..153fb94 --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +Copyright © 2020, Antorica LLC +All rights reserved diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/digit.cabal b/digit.cabal new file mode 100644 index 0000000..093a7c3 --- /dev/null +++ b/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 diff --git a/spec/DigitSpec.hs b/spec/DigitSpec.hs new file mode 100644 index 0000000..131e5d3 --- /dev/null +++ b/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 diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/src/Data/Digit.hs b/src/Data/Digit.hs new file mode 100644 index 0000000..cabf093 --- /dev/null +++ b/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)