diff --git a/ascii-numbers.cabal b/ascii-numbers.cabal new file mode 100644 --- /dev/null +++ b/ascii-numbers.cabal @@ -0,0 +1,78 @@ +cabal-version: 3.0 + +name: ascii-numbers +version: 1.0.0.0 +synopsis: ASCII representations of numbers +category: Data, Numeric, Text + +description: + This package provides functions for converting back and + forth between numbers and their ASCII representations. + +license: Apache-2.0 +license-file: license.txt + +author: Chris Martin +maintainer: Chris Martin, Julie Moronuki + +homepage: https://github.com/typeclasses/ascii +bug-Reports: https://github.com/typeclasses/ascii/issues + +build-type: Simple + +source-repository head + type: git + location: git://github.com/typeclasses/ascii.git + +common base + default-language: Haskell2010 + ghc-options: -Wall + + default-extensions: + DeriveAnyClass + DeriveDataTypeable + DeriveGeneric + DerivingStrategies + FlexibleInstances + LambdaCase + NoImplicitPrelude + StandaloneDeriving + + build-depends: + ascii-case ^>= 1.0 + , ascii-char ^>= 1.0 + , ascii-superset ^>= 1.0.1 + , base >= 4.13 && < 4.17 + , bytestring ^>= 0.10 || ^>= 0.11 + , d10 ^>= 1.0.1 + , hashable >= 1.3 && < 1.5 + , text ^>= 1.2.4 + +library + import: base + hs-source-dirs: library + + exposed-modules: + ASCII.Decimal + , ASCII.Hexadecimal + + other-modules: + DList + +test-suite test-ascii-numbers + import: base + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + + build-depends: + ascii-numbers + , hedgehog ^>= 1.0.1 || ^>= 1.1 + , invert ^>= 1.0 + + default-extensions: + OverloadedStrings + QuasiQuotes + ScopedTypeVariables + TemplateHaskell + TypeApplications diff --git a/library/ASCII/Decimal.hs b/library/ASCII/Decimal.hs new file mode 100644 --- /dev/null +++ b/library/ASCII/Decimal.hs @@ -0,0 +1,346 @@ +module ASCII.Decimal + ( + {- * Read/show for numeric strings -} + {- ** Natural -} showNatural, readNatural, + {- ** Integer -} showInteger, readInteger, + {- ** Integral -} showIntegral, readIntegral, + + {- * The digit type -} D10 (..), + + {- * Decimal digit superset classes -} + {- ** Of digit -} DigitSuperset (..), + {- ** Of digit lists -} DigitStringSuperset (..), + + {- * Character/number conversions -} + {- ** Natural -} naturalDigitMaybe, digitNatural, + {- ** Integer -} integerDigitMaybe, digitInteger + + ) where + +import qualified ASCII.Char as ASCII +import ASCII.Refinement (ASCII, asciiUnsafe, lift) +import ASCII.Superset (StringSuperset, fromChar, fromCharList, toCharListMaybe, + toCharMaybe) + +import Control.Monad ((<=<), (=<<)) +import Data.Bifoldable (bifoldMap) +import Data.Bits (Bits, toIntegralSized) +import Data.Bool (Bool, (&&)) +import Data.Function (id, (.)) +import Data.Functor (fmap) +import Data.List.NonEmpty (NonEmpty, nonEmpty) +import Data.Maybe (Maybe (..), fromJust, isJust) +import Data.Monoid (mempty) +import Data.Ord (Ord (..)) +import Data.Word (Word8) +import Numeric.Natural (Natural) +import Prelude (Integer, Integral, abs, fromEnum, fromInteger, fromIntegral, + negate, quotRem, toEnum, toInteger, (*), (+), (-)) + +import qualified Data.Bool as Bool +import qualified Data.Char as Unicode +import qualified Data.List as List + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BSB +import qualified Data.ByteString.Lazy as LBS + +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Builder as TB + +import DList (DList) +import qualified DList + +import D10.Safe (D10 (..)) +import qualified D10.Safe as D10 + + +--- Show functions --- + +{- | + +Examples: + +* @showNatural 0@ = @"0"@ +* @showNatural 268@ = @"268"@ + +-} +showNatural :: DigitStringSuperset string => Natural -> string +showNatural = + \case + 0 -> fromDigitList [ D0 ] + n -> fromDigitList (naturalList n) + where + naturalList :: Natural -> [D10] + naturalList = DList.toList . r + where + r :: Natural -> DList D10 + r = \case + 0 -> mempty + n -> + bifoldMap + r + (DList.singleton . toEnum . fromIntegral) + (quotRem n 10) + +{- | + +Examples: + +* @showInteger 0@ = @"0"@ +* @showInteger 12@ = @"12"@ +* @showInteger (negate 12)@ = @"-12"@ + +-} +showInteger :: StringSuperset string => Integer -> string +showInteger = fromCharList . integerList + where + integerList :: Integer -> [ASCII.Char] + integerList = + \case + 0 -> [ ASCII.Digit0 ] + n | n < 0 -> ASCII.HyphenMinus : nonNegativeIntegerList (abs n) + n -> nonNegativeIntegerList n + + nonNegativeIntegerList :: Integer -> [ASCII.Char] + nonNegativeIntegerList = DList.toList . r + where + r :: Integer -> DList ASCII.Char + r = \case + 0 -> mempty + n -> + bifoldMap + r + (DList.singleton . fromDigit . toEnum . fromInteger) + (quotRem n 10) + +showIntegral :: (Integral n, StringSuperset string) => n -> string +showIntegral = showInteger . toInteger + + +--- Read functions --- + +{- | + +Examples: + +* @readNatural "0"@ = @Just 0@ +* @readNatural "268"@ = @Just 268@ +* @readNatural "0004"@ = @Just 4@ +* @readNatural ""@ = @Nothing@ +* @readNatural "-4"@ = @Nothing@ +* @readNatural "12345678901234567890"@ = @Just 12345678901234567890@ + +-} +readNatural :: DigitStringSuperset string => string -> Maybe Natural +readNatural = (Just . readNaturalDigits) <=< nonEmpty <=< toDigitListMaybe + where + readNaturalDigits :: NonEmpty D10 -> Natural + readNaturalDigits = List.foldl' (\total x -> (10 * total) + fromIntegral (fromEnum x)) 0 + +{- | + +Examples: + +* @readInteger "0"@ = @Just 0@ +* @readInteger "268"@ = @Just 268@ +* @readInteger "0004"@ = @Just 4@ +* @readInteger ""@ = @Nothing@ +* @readInteger "-4"@ = @Just (-4)@ +* @readInteger "12345678901234567890"@ = @Just 12345678901234567890@ + +-} +readInteger :: StringSuperset string => string -> Maybe Integer +readInteger = readIntegerCharList <=< toCharListMaybe + where + readIntegerCharList :: [ASCII.Char] -> Maybe Integer + readIntegerCharList = + \case + ASCII.HyphenMinus : xs -> fmap negate (readNonNegative xs) + xs -> readNonNegative xs + + readNonNegative :: [ASCII.Char] -> Maybe Integer + readNonNegative = (Just . toInteger . readIntegerDigits) <=< nonEmpty <=< toDigitListMaybe + + readIntegerDigits :: NonEmpty D10 -> Integer + readIntegerDigits = List.foldl' (\total x -> (10 * total) + fromIntegral (fromEnum x)) 0 + +{- | + +Examples: + +* @readIntegral "0"@ = @Just (0 :: Word8)@ +* @readIntegral "175"@ = @Just (175 :: Word8)@ +* @readIntegral "268"@ = @(Nothing :: Maybe Word8)@ +* @readIntegral "0004"@ = @Just (4 :: Word8)@ +* @readIntegral ""@ = @(Nothing :: Maybe Word8)@ +* @readIntegral "-4"@ = @(Nothing :: Maybe Word8)@ +* @readIntegral "12345678901234567890"@ = @(Nothing :: Maybe Word8)@ + +-} +readIntegral :: (StringSuperset string, Integral num, Bits num) => string -> Maybe num +readIntegral = toIntegralSized <=< readInteger + + +--- Uninteresting monomorphic specializations of polymorphic functions --- + +{- | + +Examples: + +* @naturalDigitMaybe 5@ = @Just Digit5@ +* @naturalDigitMaybe 12@ = @Nothing@ + +-} +naturalDigitMaybe :: Natural -> Maybe D10 +naturalDigitMaybe = D10.natD10Maybe + +{- | + +Examples: + +* @integerDigitMaybe 5@ = @Just Digit5@ +* @integerDigitMaybe 12@ = @Nothing@ + +-} +integerDigitMaybe :: Integer -> Maybe D10 +integerDigitMaybe = D10.integerD10Maybe + +digitNatural :: D10 -> Natural +digitNatural = D10.d10Nat + +digitInteger :: D10 -> Integer +digitInteger = D10.d10Integer + + +--- Classes --- + +class DigitSuperset char + where + + fromDigit :: D10 -> char + + isDigit :: char -> Bool + isDigit = isJust . toDigitMaybe + + toDigitUnsafe :: char -> D10 + toDigitUnsafe = fromJust . toDigitMaybe + + toDigitMaybe :: char -> Maybe D10 + toDigitMaybe x = if isDigit x then Just (toDigitUnsafe x) else Nothing + + {-# minimal fromDigit, ((isDigit, toDigitUnsafe) | toDigitMaybe) #-} + +class DigitStringSuperset string + where + + fromDigitList :: [D10] -> string + + isDigitString :: string -> Bool + isDigitString = isJust . toDigitListMaybe + + toDigitListUnsafe :: string -> [D10] + toDigitListUnsafe = fromJust . toDigitListMaybe + + toDigitListMaybe :: string -> Maybe [D10] + toDigitListMaybe x = if isDigitString x then Just (toDigitListUnsafe x) else Nothing + + {-# minimal fromDigitList, ((isDigitString, toDigitListUnsafe) | toDigitListMaybe) #-} + + +--- DigitSuperset instances --- + +instance DigitSuperset D10 + where + isDigit _ = Bool.True + fromDigit = id + toDigitUnsafe = id + toDigitMaybe = Just + +instance DigitSuperset ASCII.Char + where + isDigit x = x >= ASCII.Digit0 && x <= ASCII.Digit9 + fromDigit = toEnum . (\x -> x + fromEnum ASCII.Digit0) . fromEnum + toDigitUnsafe = toEnum . (\x -> x - fromEnum ASCII.Digit0) . fromEnum + +instance DigitSuperset Unicode.Char + where + isDigit x = x >= '0' && x <= '9' + fromDigit = Unicode.chr . (\x -> x + Unicode.ord '0') . fromEnum + toDigitUnsafe = toEnum . (\x -> x - Unicode.ord '0') . Unicode.ord + +instance DigitSuperset Word8 + where + fromDigit x = fromChar (fromDigit x :: ASCII.Char) + toDigitMaybe w = toDigitMaybe =<< (toCharMaybe w :: Maybe ASCII.Char) + +instance DigitSuperset char => DigitSuperset (ASCII char) + where + isDigit = isDigit . lift + fromDigit = asciiUnsafe . fromDigit + toDigitUnsafe = toDigitUnsafe . lift + toDigitMaybe = toDigitMaybe . lift + + +--- DigitStringSuperset instances --- + +instance DigitStringSuperset [D10] + where + isDigitString _ = Bool.True + fromDigitList = id + toDigitListUnsafe = id + toDigitListMaybe = Just + +instance DigitStringSuperset [ASCII.Char] + where + isDigitString = List.all isDigit + fromDigitList = List.map fromDigit + toDigitListUnsafe = List.map toDigitUnsafe + +instance DigitStringSuperset [Unicode.Char] + where + isDigitString = List.all isDigit + fromDigitList = List.map fromDigit + toDigitListUnsafe = List.map toDigitUnsafe + +instance DigitStringSuperset T.Text + where + isDigitString = T.all isDigit + fromDigitList = T.pack . List.map fromDigit + toDigitListUnsafe = List.map toDigitUnsafe . T.unpack + +instance DigitStringSuperset LT.Text + where + isDigitString = LT.all isDigit + fromDigitList = LT.pack . List.map fromDigit + toDigitListUnsafe = List.map toDigitUnsafe . LT.unpack + +instance DigitStringSuperset TB.Builder + where + fromDigitList = TB.fromLazyText . fromDigitList + toDigitListMaybe = toDigitListMaybe . TB.toLazyText + +instance DigitStringSuperset BS.ByteString + where + isDigitString = BS.all isDigit + fromDigitList = BS.pack . List.map fromDigit + toDigitListUnsafe = List.map toDigitUnsafe . BS.unpack + +instance DigitStringSuperset LBS.ByteString + where + isDigitString = LBS.all isDigit + fromDigitList = LBS.pack . List.map fromDigit + toDigitListUnsafe = List.map toDigitUnsafe . LBS.unpack + +instance DigitStringSuperset BSB.Builder + where + fromDigitList = BSB.lazyByteString . fromDigitList + toDigitListMaybe = toDigitListMaybe . BSB.toLazyByteString + +instance DigitStringSuperset char => DigitStringSuperset (ASCII char) + where + isDigitString = isDigitString . lift + fromDigitList = asciiUnsafe . fromDigitList + toDigitListUnsafe = toDigitListUnsafe . lift + toDigitListMaybe = toDigitListMaybe . lift diff --git a/library/ASCII/Hexadecimal.hs b/library/ASCII/Hexadecimal.hs new file mode 100644 --- /dev/null +++ b/library/ASCII/Hexadecimal.hs @@ -0,0 +1,559 @@ +module ASCII.Hexadecimal + ( + {- * Read/show for numeric strings -} + {- ** Natural -} showNatural, readNatural, + {- ** Integer -} showInteger, readInteger, + {- ** Integral -} showIntegral, readIntegral, + + {- * Various digit types -} D16 (..), HexChar (..), HexLetter (..), HexCharBreakdown (..), + + {- * Monomorphic character conversions -} + {- ** HexLetter ↔ D16 -} hexLetterD16, d16HexLetter, + {- ** HexLetter ↔ HexChar -} letterHexChar, hexCharLetter, + {- ** HexChar ↔ ASCII Char -} hexAsciiChar, asciiCharHex, + {- ** HexChar ↔ D16 -} d16HexChar, hexCharD16, + {- ** HexChar ↔ HexCharBreakdown -} breakDownHexChar, assembleHexChar, + + {- * Hexadecimal character superset classes -} + {- * Of hex character -} HexCharSuperset (..), + {- * Of hex character lists -} HexStringSuperset (..), + + {- * Character/number conversions -} + {- ** Natural ↔ HexChar -} naturalHexCharMaybe, hexCharNatural, naturalHexCharUnsafe, + {- ** Natural ↔ D16 -} naturalD16Maybe, d16Natural, naturalD16Unsafe, + {- ** Integer ↔ HexChar -} integerHexCharMaybe, hexCharInteger, integerHexCharUnsafe, + {- ** Integer ↔ D16 -} integerD16Maybe, d16Integer, integerD16Unsafe + + ) where + +import ASCII.Case (Case (..)) +import qualified ASCII.Char as ASCII +import qualified ASCII.Decimal as Dec +import ASCII.Refinement (ASCII, asciiUnsafe, lift) +import ASCII.Superset (StringSuperset, fromChar, fromCharList, toCharListMaybe, + toCharMaybe) + +import Control.Monad (guard, (<=<), (=<<)) +import Data.Bifoldable (bifoldMap) +import Data.Bits (Bits, toIntegralSized) +import Data.Bool (Bool, (&&)) +import Data.Data (Data) +import Data.Eq (Eq) +import Data.Function (id, ($), (.)) +import Data.Functor (fmap) +import Data.Hashable (Hashable) +import Data.Maybe (Maybe (Just, Nothing), fromJust, isJust) +import Data.Monoid (mempty) +import Data.Ord (Ord (..)) +import Data.Word (Word8) +import GHC.Generics (Generic) +import Numeric.Natural (Natural) +import Prelude (Bounded (..), Enum (..), Integer, Integral, abs, fromEnum, + fromInteger, fromIntegral, negate, quotRem, toEnum, toInteger, + (*), (+), (-)) +import Text.Show (Show) + +import qualified Data.Bool as Bool +import qualified Data.Char as Unicode +import qualified Data.List as List + +import Data.List.NonEmpty (NonEmpty, nonEmpty) + +import qualified DList + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BSB +import qualified Data.ByteString.Lazy as LBS + +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Builder as TB + +--- Types --- + +-- | A whole number between /0/ and /15/ +data D16 + = D0 -- ^ Zero + | D1 -- ^ One + | D2 -- ^ Two + | D3 -- ^ Three + | D4 -- ^ Four + | D5 -- ^ Five + | D6 -- ^ Six + | D7 -- ^ Seven + | D8 -- ^ Eight + | D9 -- ^ Nine + | D10 -- ^ Ten (A) + | D11 -- ^ Eleven (B) + | D12 -- ^ Twelve (C) + | D13 -- ^ Thirteen (D) + | D14 -- ^ Fourteen (E) + | D15 -- ^ Fifteen (F) + deriving stock (Bounded, Enum, Eq, Ord, Show, Data, Generic) + deriving anyclass Hashable + +-- | Letters used as hexadecimal digits above 9, without a notion of case. +data HexLetter = + LetterA -- ^ 10 + | LetterB -- ^ 11 + | LetterC -- ^ 12 + | LetterD -- ^ 13 + | LetterE -- ^ 14 + | LetterF -- ^ 15 + deriving stock (Bounded, Enum, Eq, Ord, Show, Data, Generic) + deriving anyclass Hashable + +{- | The subset of ASCII used to represent hexadecimal numbers: + +* 'ASCII.Char.Digit0' to 'ASCII.Char.Digit9' +* 'ASCII.Char.CapitalLetterA' to 'ASCII.Char.CapitalLetterF' +* 'ASCII.Char.SmallLetterA' to 'ASCII.Char.SmallLetterF' +-} +data HexChar = + Digit0 | Digit1 | Digit2 | Digit3 | Digit4 + | Digit5 | Digit6 | Digit7 | Digit8 | Digit9 + | CapitalLetterA | CapitalLetterB | CapitalLetterC + | CapitalLetterD | CapitalLetterE | CapitalLetterF + | SmallLetterA | SmallLetterB | SmallLetterC + | SmallLetterD | SmallLetterE | SmallLetterF + deriving stock (Bounded, Enum, Eq, Ord, Show, Data, Generic) + deriving anyclass Hashable + +data HexCharBreakdown = HexDigit Dec.D10 | HexLetter Case HexLetter + deriving stock (Eq, Ord, Show, Data, Generic) + deriving anyclass Hashable + +-- | Behaves the same as 'HexChar' +instance Enum HexCharBreakdown + where + fromEnum = fromEnum . assembleHexChar + toEnum = breakDownHexChar . toEnum + +-- | Behaves the same as 'HexChar' +instance Bounded HexCharBreakdown + where + minBound = breakDownHexChar minBound + maxBound = breakDownHexChar maxBound + + +--- Monomorphic conversions between the character types --- + +breakDownHexChar :: HexChar -> HexCharBreakdown +breakDownHexChar = + \case + x | x <= Digit9 -> HexDigit (toEnum (fromEnum x)) + x | x <= CapitalLetterF -> HexLetter UpperCase (toEnum (fromEnum x - 10)) + x -> HexLetter LowerCase (toEnum (fromEnum x - 16)) + +assembleHexChar :: HexCharBreakdown -> HexChar +assembleHexChar = + \case + HexDigit x -> toEnum (fromEnum x) + HexLetter UpperCase x -> toEnum (fromEnum x + 10) + HexLetter LowerCase x -> toEnum (fromEnum x + 16) + +d16HexChar :: Case -> D16 -> HexChar +d16HexChar c = + toEnum + . + case c of + UpperCase -> fromEnum + LowerCase -> \case + x | x <= D9 -> fromEnum x + x -> fromEnum x + 6 + +hexCharD16 :: HexChar -> D16 +hexCharD16 = + \case + x | x < SmallLetterA -> toEnum (fromEnum x) + x -> toEnum (fromEnum x - 6) + +hexAsciiChar :: HexChar -> ASCII.Char +hexAsciiChar = + toEnum + . + \case + x | x <= Digit9 -> fromEnum ASCII.Digit0 + fromEnum x + x | x <= CapitalLetterF -> fromEnum ASCII.CapitalLetterA + fromEnum x - 10 + x -> fromEnum ASCII.SmallLetterA + fromEnum x - 16 + +asciiCharHex :: ASCII.Char -> Maybe HexChar +asciiCharHex = + \case + x | x >= ASCII.Digit0 && x <= ASCII.Digit9 -> + Just $ toEnum $ + fromEnum x - fromEnum ASCII.Digit0 + + x | x >= ASCII.CapitalLetterA && x <= ASCII.CapitalLetterF -> + Just $ toEnum $ + fromEnum x + 10 - fromEnum ASCII.CapitalLetterA + + x | x >= ASCII.SmallLetterA && x <= ASCII.SmallLetterF -> + Just $ toEnum $ + fromEnum x + 16 - fromEnum ASCII.SmallLetterA + + _ -> Nothing + +hexLetterD16 :: HexLetter -> D16 +hexLetterD16 = toEnum . (\x -> x + 10) . fromEnum + +d16HexLetter :: D16 -> Maybe HexLetter +d16HexLetter x = + do + guard (x >= D10) + Just (toEnum (fromEnum x - 10)) + +letterHexChar :: Case -> HexLetter -> HexChar +letterHexChar = \case + UpperCase -> toEnum . (\x -> x + 10) . fromEnum + LowerCase -> toEnum . (\x -> x + 16) . fromEnum + +hexCharLetter :: HexChar -> Maybe HexLetter +hexCharLetter = \case + x | x <= Digit9 -> Nothing + x | x <= CapitalLetterF -> Just (toEnum (fromEnum x - 10)) + x -> Just (toEnum (fromEnum x - 16)) + + +--- Monomorphic character/number conversions --- + +naturalHexCharMaybe :: Case -> Natural -> Maybe HexChar +naturalHexCharMaybe = + \case + UpperCase -> \case + x | x <= 15 -> Just (toEnum (fromIntegral x)) + _ -> Nothing + LowerCase -> \case + x | x <= 9 -> Just (toEnum (fromIntegral x)) + x | x <= 15 -> Just (toEnum (fromIntegral x + 6)) + _ -> Nothing + +naturalHexCharUnsafe :: Case -> Natural -> HexChar +naturalHexCharUnsafe = + \case + UpperCase -> \x -> toEnum (fromIntegral x) + LowerCase -> \case + x | x <= 9 -> toEnum (fromIntegral x) + x -> toEnum (fromIntegral x + 6) + +hexCharNatural :: HexChar -> Natural +hexCharNatural = + fromIntegral + . + \case + x | x > 15 -> x - 6 + x -> x + . + fromEnum + +integerHexCharMaybe :: Case -> Integer -> Maybe HexChar +integerHexCharMaybe = + \case + UpperCase -> \case + x | x < 0 -> Nothing + x | x <= 15 -> Just (toEnum (fromIntegral x)) + _ -> Nothing + LowerCase -> \case + x | x < 0 -> Nothing + x | x <= 9 -> Just (toEnum (fromIntegral x)) + x | x <= 15 -> Just (toEnum (fromIntegral x + 6)) + _ -> Nothing + +integerHexCharUnsafe :: Case -> Integer -> HexChar +integerHexCharUnsafe = + \case + UpperCase -> \x -> toEnum (fromIntegral x) + LowerCase -> \case + x | x <= 9 -> toEnum (fromIntegral x) + x -> toEnum (fromIntegral x + 6) + +hexCharInteger :: HexChar -> Integer +hexCharInteger = + fromIntegral + . + \case + x | x > 15 -> x - 6 + x -> x + . + fromEnum + +naturalD16Maybe :: Natural -> Maybe D16 +naturalD16Maybe = + \case + x | x <= 15 -> Just (toEnum (fromIntegral x)) + _ -> Nothing + +d16Natural :: D16 -> Natural +d16Natural = fromIntegral . fromEnum + +integerD16Maybe :: Integer -> Maybe D16 +integerD16Maybe = + \case + x | x < 0 -> Nothing + x | x <= 15 -> Just (toEnum (fromInteger x)) + _ -> Nothing + +d16Integer :: D16 -> Integer +d16Integer = toInteger . fromEnum + +naturalD16Unsafe :: Natural -> D16 +naturalD16Unsafe = toEnum . fromIntegral + +integerD16Unsafe :: Integer -> D16 +integerD16Unsafe = toEnum . fromIntegral + + +--- Classes --- + +class HexCharSuperset char + where + + fromHexChar :: HexChar -> char + + isHexChar :: char -> Bool + isHexChar = isJust . toHexCharMaybe + + toHexCharUnsafe :: char -> HexChar + toHexCharUnsafe = fromJust . toHexCharMaybe + + toHexCharMaybe :: char -> Maybe HexChar + toHexCharMaybe x = if isHexChar x then Just (toHexCharUnsafe x) else Nothing + + {-# minimal fromHexChar, ((isHexChar, toHexCharUnsafe) | toHexCharMaybe) #-} + +class HexStringSuperset string + where + + fromHexCharList :: [HexChar] -> string + + isHexString :: string -> Bool + isHexString = isJust . toHexCharListMaybe + + toHexCharListUnsafe :: string -> [HexChar] + toHexCharListUnsafe = fromJust . toHexCharListMaybe + + toHexCharListMaybe :: string -> Maybe [HexChar] + toHexCharListMaybe x = if isHexString x then Just (toHexCharListUnsafe x) else Nothing + + {-# minimal fromHexCharList, ((isHexString, toHexCharListUnsafe) | toHexCharListMaybe) #-} + + +--- Show functions --- + +{- | + +Examples: + +* @showNatural LowerCase 12@ = @"c"@ +* @showNatural UpperCase (256 + 12)@ = @"10C"@ +* @showNatural UpperCase 0@ = @"0"@ + +-} +showNatural :: HexStringSuperset string => Case -> Natural -> string +showNatural = + \c -> \case + 0 -> fromHexCharList [ Digit0 ] + n -> fromHexCharList (fmap (d16HexChar c) (naturalList n)) + where + naturalList :: Natural -> [D16] + naturalList = DList.toList . r + where + r = \case + 0 -> mempty + n -> + bifoldMap + r + (DList.singleton . naturalD16Unsafe) + (quotRem n 16) + +{- | + +Examples: + +* @showInteger LowerCase 12@ = @"c"@ +* @showInteger LowerCase (negate 12)@ = @"-c"@ +* @showInteger UpperCase (256 + 12)@ = @"10C"@ +* @showInteger UpperCase (negate (256 + 12))@ = @"-10C"@ +* @showInteger UpperCase 0@ = @"0"@ + +-} +showInteger :: StringSuperset string => Case -> Integer -> string +showInteger = \c -> fromCharList . integerList c + where + integerList :: Case -> Integer -> [ASCII.Char] + integerList c = + \case + 0 -> [ ASCII.Digit0 ] + n | n < 0 -> ASCII.HyphenMinus : nonNegativeIntegerList c (abs n) + n -> nonNegativeIntegerList c n + + nonNegativeIntegerList :: Case -> Integer -> [ASCII.Char] + nonNegativeIntegerList c = DList.toList . r + where + r = \case + 0 -> mempty + n -> + bifoldMap + r + (DList.singleton . fromHexChar . integerHexCharUnsafe c) + (quotRem n 16) + +showIntegral :: (StringSuperset string, Integral number) => Case -> number -> string +showIntegral c = showInteger c . toInteger + + +--- Read functions --- + +{- | + +Examples: + +* @readNatural "5"@ = @Just 5@ +* @readNatural "-5"@ = @Nothing@ +* @readNatural "1f"@ = @Just 31@ +* @readNatural "1F"@ = @Just 31@ +* @readNatural "xa"@ = @Nothing@ +* @readNatural ""@ = @Nothing@ + +-} +readNatural :: HexStringSuperset string => string -> Maybe Natural +readNatural = (Just . readNaturalDigits) <=< nonEmpty <=< (Just . fmap hexCharD16) <=< toHexCharListMaybe + where + readNaturalDigits :: NonEmpty D16 -> Natural + readNaturalDigits = List.foldl' (\total x -> (16 * total) + d16Natural x) 0 + +{- | + +Examples: + +* @readInteger "5"@ = @Just 5@ +* @readInteger "-5"@ = @Just (-5)@ +* @readInteger "1f"@ = @Just 31@ +* @readInteger "1F"@ = @Just 31@ +* @readInteger "xa"@ = @Nothing@ +* @readInteger ""@ = @Nothing@ +* @readInteger "-"@ = @Nothing@ + +-} +readInteger :: StringSuperset string => string -> Maybe Integer +readInteger = readIntegerCharList <=< toCharListMaybe + where + readIntegerCharList :: [ASCII.Char] -> Maybe Integer + readIntegerCharList = + \case + ASCII.HyphenMinus : xs -> fmap negate (readNonNegative xs) + xs -> readNonNegative xs + + readNonNegative :: [ASCII.Char] -> Maybe Integer + readNonNegative = (Just . toInteger . readIntegerDigits) <=< nonEmpty <=< (Just . fmap hexCharD16) <=< toHexCharListMaybe + + readIntegerDigits :: NonEmpty D16 -> Integer + readIntegerDigits = List.foldl' (\total x -> (16 * total) + d16Integer x) 0 + +{- | + +Examples: + +* @readIntegral "0014"@ = @Just (20 :: Word8)@ +* @readIntegral ""@ = @(Nothing :: Maybe Word8)@ +* @readIntegral "-4"@ = @(Nothing :: Maybe Word8)@ +* @readIntegral "1234"@ = @(Nothing :: Maybe Word8)@ + +-} +readIntegral :: (StringSuperset string, Integral number, Bits number) => string -> Maybe number +readIntegral = toIntegralSized <=< readInteger + + +--- HexCharSuperset instances --- + +instance HexCharSuperset HexChar + where + isHexChar _ = Bool.True + fromHexChar = id + toHexCharUnsafe = id + toHexCharMaybe = Just + +instance HexCharSuperset ASCII.Char + where + fromHexChar = hexAsciiChar + toHexCharMaybe = asciiCharHex + +instance HexCharSuperset Unicode.Char + where + fromHexChar = fromChar . fromHexChar + toHexCharMaybe = toHexCharMaybe <=< toCharMaybe + +instance HexCharSuperset Word8 + where + fromHexChar x = fromChar (fromHexChar x :: ASCII.Char) + toHexCharMaybe w = toHexCharMaybe =<< (toCharMaybe w :: Maybe ASCII.Char) + +instance HexCharSuperset char => HexCharSuperset (ASCII char) + where + isHexChar = isHexChar . lift + fromHexChar = asciiUnsafe . fromHexChar + toHexCharUnsafe = toHexCharUnsafe . lift + toHexCharMaybe = toHexCharMaybe . lift + + +--- HexStringSuperset instances --- + +instance HexStringSuperset [HexChar] + where + fromHexCharList = id + isHexString _ = Bool.True + toHexCharListUnsafe = id + toHexCharListMaybe = Just + +instance HexStringSuperset [ASCII.Char] + where + fromHexCharList = List.map fromHexChar + isHexString = List.all isHexChar + toHexCharListUnsafe = List.map toHexCharUnsafe + +instance HexStringSuperset [Unicode.Char] + where + fromHexCharList = List.map fromHexChar + isHexString = List.all isHexChar + toHexCharListUnsafe = List.map toHexCharUnsafe + +instance HexStringSuperset T.Text + where + fromHexCharList = T.pack . List.map fromHexChar + isHexString = T.all isHexChar + toHexCharListUnsafe = List.map toHexCharUnsafe . T.unpack + +instance HexStringSuperset LT.Text + where + fromHexCharList = LT.pack . List.map fromHexChar + isHexString = LT.all isHexChar + toHexCharListUnsafe = List.map toHexCharUnsafe . LT.unpack + +instance HexStringSuperset TB.Builder + where + fromHexCharList = TB.fromLazyText . fromHexCharList + toHexCharListMaybe = toHexCharListMaybe . TB.toLazyText + +instance HexStringSuperset BS.ByteString + where + fromHexCharList = BS.pack . List.map fromHexChar + isHexString = BS.all isHexChar + toHexCharListUnsafe = List.map toHexCharUnsafe . BS.unpack + +instance HexStringSuperset LBS.ByteString + where + fromHexCharList = LBS.pack . List.map fromHexChar + isHexString = LBS.all isHexChar + toHexCharListUnsafe = List.map toHexCharUnsafe . LBS.unpack + +instance HexStringSuperset BSB.Builder + where + fromHexCharList = BSB.lazyByteString . fromHexCharList + toHexCharListMaybe = toHexCharListMaybe . BSB.toLazyByteString + +instance HexStringSuperset char => HexStringSuperset (ASCII char) + where + isHexString = isHexString . lift + fromHexCharList = asciiUnsafe . fromHexCharList + toHexCharListUnsafe = toHexCharListUnsafe . lift + toHexCharListMaybe = toHexCharListMaybe . lift diff --git a/library/DList.hs b/library/DList.hs new file mode 100644 --- /dev/null +++ b/library/DList.hs @@ -0,0 +1,21 @@ +module DList where + +import Data.Function ((.), id) +import Data.Monoid (Monoid (mempty)) +import Data.Semigroup (Semigroup ((<>))) + +newtype DList a = DList ([a] -> [a]) + +toList :: DList a -> [a] +toList (DList f) = f [] + +singleton :: a -> DList a +singleton x = DList (x :) + +instance Semigroup (DList a) + where + DList f <> DList g = DList (f . g) + +instance Monoid (DList a) + where + mempty = DList id diff --git a/license.txt b/license.txt new file mode 100644 --- /dev/null +++ b/license.txt @@ -0,0 +1,13 @@ +Copyright 2022 Mission Valley Software LLC + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,778 @@ +module Main (main) where + +import ASCII.Case (Case (..)) +import qualified ASCII.Char as ASCII +import qualified ASCII.Decimal as Dec +import qualified ASCII.Hexadecimal as Hex + +import Control.Applicative (liftA2) +import Control.Monad (Monad (..), when) +import Data.Bool (not) +import Data.Eq (Eq) +import Data.Foldable (for_) +import Data.Function (fix, ($), (.)) +import Data.List (map, splitAt) +import Data.Maybe (Maybe (..)) +import Data.String (String) +import Data.Tuple (uncurry) +import Data.Word (Word8) +import Numeric.Natural (Natural) +import Prelude (Bounded (..), Enum (..), Integer, negate, (+), (-)) +import System.Exit (exitFailure) +import System.IO (IO) +import Text.Show (Show) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as List +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Invert as I + +import Hedgehog (Gen, MonadTest, Property, PropertyT, checkParallel, discover, + forAll, property, withTests, (===)) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +main :: IO () +main = checkParallel $$(discover) >>= \ok -> when (not ok) exitFailure + +prop_showNatural_12 :: Property +prop_showNatural_12 = withTests 1 $ property $ + Dec.showNatural 12 === ("12" :: T.Text) + +prop_showNatural_268 :: Property +prop_showNatural_268 = withTests 1 $ property $ + Dec.showNatural 268 === ("268" :: String) + +prop_showInteger_12 :: Property +prop_showInteger_12 = withTests 1 $ property $ + Dec.showInteger 12 === ("12" :: T.Text) + +prop_showInteger_minus12 :: Property +prop_showInteger_minus12 = withTests 1 $ property $ + Dec.showInteger (negate 12) === ("-12" :: LT.Text) + +prop_showInteger_268 :: Property +prop_showInteger_268 = withTests 1 $ property $ + Dec.showInteger 268 === ("268" :: LT.Text) + +prop_showInteger_minus268 :: Property +prop_showInteger_minus268 = withTests 1 $ property $ + Dec.showInteger (negate 268) === ("-268" :: LT.Text) + +prop_showNatural_0_to_9 :: Property +prop_showNatural_0_to_9 = withTests 1 $ property $ + T.unwords (map Dec.showNatural [0..9]) === ("0 1 2 3 4 5 6 7 8 9" :: T.Text) + +prop_showNatural_10_to_99 :: Property +prop_showNatural_10_to_99 = withTests 1 $ property $ + let + ne f xs = case xs of [] -> []; _ -> f xs + groupsOf n = fix $ \r -> ne $ \xs -> let (x, ys) = splitAt n xs in x : r ys + res :: [T.Text] + res = map T.unwords $ groupsOf 10 $ map Dec.showNatural [10..99] + in + res === + [ "10 11 12 13 14 15 16 17 18 19" + , "20 21 22 23 24 25 26 27 28 29" + , "30 31 32 33 34 35 36 37 38 39" + , "40 41 42 43 44 45 46 47 48 49" + , "50 51 52 53 54 55 56 57 58 59" + , "60 61 62 63 64 65 66 67 68 69" + , "70 71 72 73 74 75 76 77 78 79" + , "80 81 82 83 84 85 86 87 88 89" + , "90 91 92 93 94 95 96 97 98 99" + ] + +prop_showNaturalHex_0_to_f_lower :: Property +prop_showNaturalHex_0_to_f_lower = withTests 1 $ property $ + T.unwords (List.map (Hex.showNatural LowerCase) [0..15]) + === "0 1 2 3 4 5 6 7 8 9 a b c d e f" + +prop_showNaturalHex_0_to_f_upper :: Property +prop_showNaturalHex_0_to_f_upper = withTests 1 $ property $ + T.unwords (List.map (Hex.showNatural UpperCase) [0..15]) + === "0 1 2 3 4 5 6 7 8 9 A B C D E F" + +prop_showNaturalHex_10_to_ff :: Property +prop_showNaturalHex_10_to_ff = withTests 1 $ property $ + let + ne f xs = case xs of [] -> []; _ -> f xs + groupsOf n = fix $ \r -> ne $ \xs -> let (x, ys) = splitAt n xs in x : r ys + res :: [LT.Text] + res = map LT.unwords $ groupsOf 16 $ map (Hex.showNatural LowerCase) [16..255] + in + res === + [ "10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f" + , "20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f" + , "30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f" + , "40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f" + , "50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f" + , "60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f" + , "70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f" + , "80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f" + , "90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f" + , "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af" + , "b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf" + , "c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf" + , "d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df" + , "e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef" + , "f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff" + ] + +prop_toDigitListMaybe :: Property +prop_toDigitListMaybe = withTests 1 $ property $ + Dec.toDigitListMaybe ("846" :: T.Text) === Just [Dec.D8, Dec.D4, Dec.D6] + +prop_toDigitListMaybe_fail :: Property +prop_toDigitListMaybe_fail = withTests 1 $ property $ + Dec.toDigitListMaybe ("84a6" :: T.Text) === Nothing + +prop_showNatural_0 :: Property +prop_showNatural_0 = withTests 1 $ property $ + Dec.showNatural 0 === ("0" :: T.Text) + +prop_showInteger_0 :: Property +prop_showInteger_0 = withTests 1 $ property $ + Dec.showInteger 0 === ("0" :: T.Text) + +prop_readNatural_0 :: Property +prop_readNatural_0 = withTests 1 $ property $ + Dec.readNatural ("0" :: T.Text) === Just 0 + +prop_readNatural_268 :: Property +prop_readNatural_268 = withTests 1 $ property $ + Dec.readNatural ("268" :: BS.ByteString) === Just 268 + +prop_readNatural_0004 :: Property +prop_readNatural_0004 = withTests 1 $ property $ + Dec.readNatural ("0004" :: T.Text) === Just 4 + +prop_readNatural_empty :: Property +prop_readNatural_empty = withTests 1 $ property $ + Dec.readNatural ("" :: T.Text) === Nothing + +prop_readNatural_minus4 :: Property +prop_readNatural_minus4 = withTests 1 $ property $ + Dec.readNatural ("-4" :: BS.ByteString) === Nothing + +prop_readNatural_big :: Property +prop_readNatural_big = withTests 1 $ property $ + Dec.readNatural ("12345678901234567890" :: T.Text) === Just 12345678901234567890 + +prop_readInteger_0 :: Property +prop_readInteger_0 = withTests 1 $ property $ + Dec.readInteger ("0" :: T.Text) === Just 0 + +prop_readInteger_268 :: Property +prop_readInteger_268 = withTests 1 $ property $ + Dec.readInteger ("268" :: T.Text) === Just 268 + +prop_readInteger_0004 :: Property +prop_readInteger_0004 = withTests 1 $ property $ + Dec.readInteger ("0004" :: T.Text) === Just 4 + +prop_readInteger_empty :: Property +prop_readInteger_empty = withTests 1 $ property $ + Dec.readInteger ("" :: T.Text) === Nothing + +prop_readInteger_minus4 :: Property +prop_readInteger_minus4 = withTests 1 $ property $ + Dec.readInteger ("-4" :: BS.ByteString) === Just (-4) + +prop_readInteger_minus :: Property +prop_readInteger_minus = withTests 1 $ property $ + Dec.readInteger ("-" :: T.Text) === Nothing + +prop_readInteger_big :: Property +prop_readInteger_big = withTests 1 $ property $ + Dec.readInteger ("12345678901234567890" :: BS.ByteString) === Just 12345678901234567890 + +prop_readIntegral_word8_0 :: Property +prop_readIntegral_word8_0 = withTests 1 $ property $ + Dec.readIntegral ("0" :: T.Text) === Just (0 :: Word8) + +prop_readIntegral_word8_175 :: Property +prop_readIntegral_word8_175 = withTests 1 $ property $ + Dec.readIntegral ("175" :: T.Text) === Just (175 :: Word8) + +prop_readIntegral_word8_268 :: Property +prop_readIntegral_word8_268 = withTests 1 $ property $ + Dec.readIntegral ("268" :: T.Text) === (Nothing :: Maybe Word8) + +prop_readIntegral_word8_0004 :: Property +prop_readIntegral_word8_0004 = withTests 1 $ property $ + Dec.readIntegral ("0004" :: T.Text) === Just (4 :: Word8) + +prop_readIntegral_word8_empty :: Property +prop_readIntegral_word8_empty = withTests 1 $ property $ + Dec.readIntegral ("" :: T.Text) === (Nothing :: Maybe Word8) + +prop_readIntegral_word8_minus4 :: Property +prop_readIntegral_word8_minus4 = withTests 1 $ property $ + Dec.readIntegral ("-4" :: T.Text) === (Nothing :: Maybe Word8) + +prop_readIntegral_word8_big :: Property +prop_readIntegral_word8_big = withTests 1 $ property $ + Dec.readIntegral ("12345678901234567890" :: T.Text) === (Nothing :: Maybe Word8) + +prop_readIntegral_natural_4 :: Property +prop_readIntegral_natural_4 = withTests 1 $ property $ + Dec.readIntegral ("4" :: T.Text) === Just (4 :: Natural) + +prop_readIntegral_natural_minus4 :: Property +prop_readIntegral_natural_minus4 = withTests 1 $ property $ + Dec.readIntegral ("-4" :: T.Text) === (Nothing :: Maybe Natural) + +prop_naturalDigitMaybe_5 :: Property +prop_naturalDigitMaybe_5 = withTests 1 $ property $ + Dec.naturalDigitMaybe 5 === Just Dec.D5 + +prop_naturalDigitMaybe_12 :: Property +prop_naturalDigitMaybe_12 = withTests 1 $ property $ + Dec.naturalDigitMaybe 12 === Nothing + +prop_integerDigitMaybe_5 :: Property +prop_integerDigitMaybe_5 = withTests 1 $ property $ + Dec.integerDigitMaybe 5 === Just Dec.D5 + +prop_integerDigitMaybe_12 :: Property +prop_integerDigitMaybe_12 = withTests 1 $ property $ + Dec.integerDigitMaybe 12 === Nothing + +checkEnumBounded :: forall a f. (MonadTest f, Enum a, Bounded a, Eq a, Show a) => [a] -> f () +checkEnumBounded xs = + do + [minBound .. maxBound] === xs + List.map toEnum [0 .. List.length xs - 1] === xs + List.map fromEnum xs === [0 .. List.length xs - 1] + +prop_D16_enumBounded :: Property +prop_D16_enumBounded = withTests 1 $ property $ + checkEnumBounded + [ Hex.D0, Hex.D1, Hex.D2, Hex.D3 + , Hex.D4, Hex.D5, Hex.D6, Hex.D7 + , Hex.D8, Hex.D9, Hex.D10, Hex.D11 + , Hex.D12, Hex.D13, Hex.D14, Hex.D15 + ] + +prop_HexLetter_enumBounded :: Property +prop_HexLetter_enumBounded = withTests 1 $ property $ + checkEnumBounded + [ Hex.LetterA, Hex.LetterB, Hex.LetterC + , Hex.LetterD, Hex.LetterE, Hex.LetterF + ] + +prop_HexChar_enumBounded :: Property +prop_HexChar_enumBounded = withTests 1 $ property $ + checkEnumBounded + [ Hex.Digit0, Hex.Digit1, Hex.Digit2, Hex.Digit3, Hex.Digit4 + , Hex.Digit5, Hex.Digit6, Hex.Digit7, Hex.Digit8, Hex.Digit9 + , Hex.CapitalLetterA, Hex.CapitalLetterB, Hex.CapitalLetterC + , Hex.CapitalLetterD, Hex.CapitalLetterE, Hex.CapitalLetterF + , Hex.SmallLetterA, Hex.SmallLetterB, Hex.SmallLetterC + , Hex.SmallLetterD, Hex.SmallLetterE, Hex.SmallLetterF + ] + +prop_HexCharBreakdown_enumBounded :: Property +prop_HexCharBreakdown_enumBounded = withTests 1 $ property $ + checkEnumBounded + [ Hex.HexDigit Dec.D0 + , Hex.HexDigit Dec.D1 + , Hex.HexDigit Dec.D2 + , Hex.HexDigit Dec.D3 + , Hex.HexDigit Dec.D4 + , Hex.HexDigit Dec.D5 + , Hex.HexDigit Dec.D6 + , Hex.HexDigit Dec.D7 + , Hex.HexDigit Dec.D8 + , Hex.HexDigit Dec.D9 + , Hex.HexLetter UpperCase Hex.LetterA + , Hex.HexLetter UpperCase Hex.LetterB + , Hex.HexLetter UpperCase Hex.LetterC + , Hex.HexLetter UpperCase Hex.LetterD + , Hex.HexLetter UpperCase Hex.LetterE + , Hex.HexLetter UpperCase Hex.LetterF + , Hex.HexLetter LowerCase Hex.LetterA + , Hex.HexLetter LowerCase Hex.LetterB + , Hex.HexLetter LowerCase Hex.LetterC + , Hex.HexLetter LowerCase Hex.LetterD + , Hex.HexLetter LowerCase Hex.LetterE + , Hex.HexLetter LowerCase Hex.LetterF + ] + +every :: (Enum a, Bounded a) => [a] +every = [minBound .. maxBound] + +functionEq :: (MonadTest f, Eq a, Show a) => [t] -> (t -> a) -> (t -> a) -> f () +functionEq xs f g = + for_ xs $ \x -> + f x === g x + +prop_hexLetterD16 :: Property +prop_hexLetterD16 = withTests 1 $ property $ + functionEq every Hex.hexLetterD16 $ \case + Hex.LetterA -> Hex.D10 + Hex.LetterB -> Hex.D11 + Hex.LetterC -> Hex.D12 + Hex.LetterD -> Hex.D13 + Hex.LetterE -> Hex.D14 + Hex.LetterF -> Hex.D15 + +prop_d16HexLetter :: Property +prop_d16HexLetter = withTests 1 $ property $ + functionEq every Hex.d16HexLetter $ + I.injection I.linearSearchLazy every Hex.hexLetterD16 + +prop_letterHexChar :: Property +prop_letterHexChar = withTests 1 $ property $ + functionEq (liftA2 (,) every every) (uncurry Hex.letterHexChar) $ \case + (UpperCase, Hex.LetterA) -> Hex.CapitalLetterA + (UpperCase, Hex.LetterB) -> Hex.CapitalLetterB + (UpperCase, Hex.LetterC) -> Hex.CapitalLetterC + (UpperCase, Hex.LetterD) -> Hex.CapitalLetterD + (UpperCase, Hex.LetterE) -> Hex.CapitalLetterE + (UpperCase, Hex.LetterF) -> Hex.CapitalLetterF + (LowerCase, Hex.LetterA) -> Hex.SmallLetterA + (LowerCase, Hex.LetterB) -> Hex.SmallLetterB + (LowerCase, Hex.LetterC) -> Hex.SmallLetterC + (LowerCase, Hex.LetterD) -> Hex.SmallLetterD + (LowerCase, Hex.LetterE) -> Hex.SmallLetterE + (LowerCase, Hex.LetterF) -> Hex.SmallLetterF + +prop_hexCharLetter :: Property +prop_hexCharLetter = withTests 1 $ property $ + functionEq every Hex.hexCharLetter $ \case + Hex.CapitalLetterA -> Just Hex.LetterA + Hex.CapitalLetterB -> Just Hex.LetterB + Hex.CapitalLetterC -> Just Hex.LetterC + Hex.CapitalLetterD -> Just Hex.LetterD + Hex.CapitalLetterE -> Just Hex.LetterE + Hex.CapitalLetterF -> Just Hex.LetterF + Hex.SmallLetterA -> Just Hex.LetterA + Hex.SmallLetterB -> Just Hex.LetterB + Hex.SmallLetterC -> Just Hex.LetterC + Hex.SmallLetterD -> Just Hex.LetterD + Hex.SmallLetterE -> Just Hex.LetterE + Hex.SmallLetterF -> Just Hex.LetterF + _ -> Nothing + +prop_hexAsciiChar :: Property +prop_hexAsciiChar = withTests 1 $ property $ + functionEq every Hex.hexAsciiChar $ \case + Hex.Digit0 -> ASCII.Digit0 + Hex.Digit1 -> ASCII.Digit1 + Hex.Digit2 -> ASCII.Digit2 + Hex.Digit3 -> ASCII.Digit3 + Hex.Digit4 -> ASCII.Digit4 + Hex.Digit5 -> ASCII.Digit5 + Hex.Digit6 -> ASCII.Digit6 + Hex.Digit7 -> ASCII.Digit7 + Hex.Digit8 -> ASCII.Digit8 + Hex.Digit9 -> ASCII.Digit9 + Hex.CapitalLetterA -> ASCII.CapitalLetterA + Hex.CapitalLetterB -> ASCII.CapitalLetterB + Hex.CapitalLetterC -> ASCII.CapitalLetterC + Hex.CapitalLetterD -> ASCII.CapitalLetterD + Hex.CapitalLetterE -> ASCII.CapitalLetterE + Hex.CapitalLetterF -> ASCII.CapitalLetterF + Hex.SmallLetterA -> ASCII.SmallLetterA + Hex.SmallLetterB -> ASCII.SmallLetterB + Hex.SmallLetterC -> ASCII.SmallLetterC + Hex.SmallLetterD -> ASCII.SmallLetterD + Hex.SmallLetterE -> ASCII.SmallLetterE + Hex.SmallLetterF -> ASCII.SmallLetterF + +prop_asciiCharHex :: Property +prop_asciiCharHex = withTests 1 $ property $ + functionEq every Hex.asciiCharHex $ + I.injection I.linearSearchLazy every Hex.hexAsciiChar + +prop_d16HexChar :: Property +prop_d16HexChar = withTests 1 $ property $ + functionEq (liftA2 (,) every every) (uncurry Hex.d16HexChar) $ \case + (_, Hex.D0) -> Hex.Digit0 + (_, Hex.D1) -> Hex.Digit1 + (_, Hex.D2) -> Hex.Digit2 + (_, Hex.D3) -> Hex.Digit3 + (_, Hex.D4) -> Hex.Digit4 + (_, Hex.D5) -> Hex.Digit5 + (_, Hex.D6) -> Hex.Digit6 + (_, Hex.D7) -> Hex.Digit7 + (_, Hex.D8) -> Hex.Digit8 + (_, Hex.D9) -> Hex.Digit9 + (UpperCase, Hex.D10) -> Hex.CapitalLetterA + (UpperCase, Hex.D11) -> Hex.CapitalLetterB + (UpperCase, Hex.D12) -> Hex.CapitalLetterC + (UpperCase, Hex.D13) -> Hex.CapitalLetterD + (UpperCase, Hex.D14) -> Hex.CapitalLetterE + (UpperCase, Hex.D15) -> Hex.CapitalLetterF + (LowerCase, Hex.D10) -> Hex.SmallLetterA + (LowerCase, Hex.D11) -> Hex.SmallLetterB + (LowerCase, Hex.D12) -> Hex.SmallLetterC + (LowerCase, Hex.D13) -> Hex.SmallLetterD + (LowerCase, Hex.D14) -> Hex.SmallLetterE + (LowerCase, Hex.D15) -> Hex.SmallLetterF + +prop_hexCharD16 :: Property +prop_hexCharD16 = withTests 1 $ property $ + functionEq every Hex.hexCharD16 $ \case + Hex.Digit0 -> Hex.D0 + Hex.Digit1 -> Hex.D1 + Hex.Digit2 -> Hex.D2 + Hex.Digit3 -> Hex.D3 + Hex.Digit4 -> Hex.D4 + Hex.Digit5 -> Hex.D5 + Hex.Digit6 -> Hex.D6 + Hex.Digit7 -> Hex.D7 + Hex.Digit8 -> Hex.D8 + Hex.Digit9 -> Hex.D9 + Hex.CapitalLetterA -> Hex.D10 + Hex.CapitalLetterB -> Hex.D11 + Hex.CapitalLetterC -> Hex.D12 + Hex.CapitalLetterD -> Hex.D13 + Hex.CapitalLetterE -> Hex.D14 + Hex.CapitalLetterF -> Hex.D15 + Hex.SmallLetterA -> Hex.D10 + Hex.SmallLetterB -> Hex.D11 + Hex.SmallLetterC -> Hex.D12 + Hex.SmallLetterD -> Hex.D13 + Hex.SmallLetterE -> Hex.D14 + Hex.SmallLetterF -> Hex.D15 + +prop_breakDownHexChar :: Property +prop_breakDownHexChar = withTests 1 $ property $ + functionEq every Hex.breakDownHexChar $ \case + Hex.Digit0 -> Hex.HexDigit Dec.D0 + Hex.Digit1 -> Hex.HexDigit Dec.D1 + Hex.Digit2 -> Hex.HexDigit Dec.D2 + Hex.Digit3 -> Hex.HexDigit Dec.D3 + Hex.Digit4 -> Hex.HexDigit Dec.D4 + Hex.Digit5 -> Hex.HexDigit Dec.D5 + Hex.Digit6 -> Hex.HexDigit Dec.D6 + Hex.Digit7 -> Hex.HexDigit Dec.D7 + Hex.Digit8 -> Hex.HexDigit Dec.D8 + Hex.Digit9 -> Hex.HexDigit Dec.D9 + Hex.CapitalLetterA -> Hex.HexLetter UpperCase Hex.LetterA + Hex.CapitalLetterB -> Hex.HexLetter UpperCase Hex.LetterB + Hex.CapitalLetterC -> Hex.HexLetter UpperCase Hex.LetterC + Hex.CapitalLetterD -> Hex.HexLetter UpperCase Hex.LetterD + Hex.CapitalLetterE -> Hex.HexLetter UpperCase Hex.LetterE + Hex.CapitalLetterF -> Hex.HexLetter UpperCase Hex.LetterF + Hex.SmallLetterA -> Hex.HexLetter LowerCase Hex.LetterA + Hex.SmallLetterB -> Hex.HexLetter LowerCase Hex.LetterB + Hex.SmallLetterC -> Hex.HexLetter LowerCase Hex.LetterC + Hex.SmallLetterD -> Hex.HexLetter LowerCase Hex.LetterD + Hex.SmallLetterE -> Hex.HexLetter LowerCase Hex.LetterE + Hex.SmallLetterF -> Hex.HexLetter LowerCase Hex.LetterF + +prop_assembleHexChar :: Property +prop_assembleHexChar = withTests 1 $ property $ + functionEq every Hex.assembleHexChar $ + I.bijection I.linearSearchLazy every Hex.breakDownHexChar + +prop_hexCharNatural :: Property +prop_hexCharNatural = withTests 1 $ property $ + functionEq every Hex.hexCharNatural $ \case + Hex.Digit0 -> 0 + Hex.Digit1 -> 1 + Hex.Digit2 -> 2 + Hex.Digit3 -> 3 + Hex.Digit4 -> 4 + Hex.Digit5 -> 5 + Hex.Digit6 -> 6 + Hex.Digit7 -> 7 + Hex.Digit8 -> 8 + Hex.Digit9 -> 9 + Hex.CapitalLetterA -> 10 + Hex.CapitalLetterB -> 11 + Hex.CapitalLetterC -> 12 + Hex.CapitalLetterD -> 13 + Hex.CapitalLetterE -> 14 + Hex.CapitalLetterF -> 15 + Hex.SmallLetterA -> 10 + Hex.SmallLetterB -> 11 + Hex.SmallLetterC -> 12 + Hex.SmallLetterD -> 13 + Hex.SmallLetterE -> 14 + Hex.SmallLetterF -> 15 + +prop_naturalHexCharMaybe :: Property +prop_naturalHexCharMaybe = withTests 1 $ property $ + functionEq (liftA2 (,) every [0 .. 20]) (uncurry Hex.naturalHexCharMaybe) $ \case + (_, 0) -> Just Hex.Digit0 + (_, 1) -> Just Hex.Digit1 + (_, 2) -> Just Hex.Digit2 + (_, 3) -> Just Hex.Digit3 + (_, 4) -> Just Hex.Digit4 + (_, 5) -> Just Hex.Digit5 + (_, 6) -> Just Hex.Digit6 + (_, 7) -> Just Hex.Digit7 + (_, 8) -> Just Hex.Digit8 + (_, 9) -> Just Hex.Digit9 + (UpperCase, 10) -> Just Hex.CapitalLetterA + (UpperCase, 11) -> Just Hex.CapitalLetterB + (UpperCase, 12) -> Just Hex.CapitalLetterC + (UpperCase, 13) -> Just Hex.CapitalLetterD + (UpperCase, 14) -> Just Hex.CapitalLetterE + (UpperCase, 15) -> Just Hex.CapitalLetterF + (LowerCase, 10) -> Just Hex.SmallLetterA + (LowerCase, 11) -> Just Hex.SmallLetterB + (LowerCase, 12) -> Just Hex.SmallLetterC + (LowerCase, 13) -> Just Hex.SmallLetterD + (LowerCase, 14) -> Just Hex.SmallLetterE + (LowerCase, 15) -> Just Hex.SmallLetterF + _ -> Nothing + +prop_hexCharInteger :: Property +prop_hexCharInteger = withTests 1 $ property $ + functionEq every Hex.hexCharInteger $ \case + Hex.Digit0 -> 0 + Hex.Digit1 -> 1 + Hex.Digit2 -> 2 + Hex.Digit3 -> 3 + Hex.Digit4 -> 4 + Hex.Digit5 -> 5 + Hex.Digit6 -> 6 + Hex.Digit7 -> 7 + Hex.Digit8 -> 8 + Hex.Digit9 -> 9 + Hex.CapitalLetterA -> 10 + Hex.CapitalLetterB -> 11 + Hex.CapitalLetterC -> 12 + Hex.CapitalLetterD -> 13 + Hex.CapitalLetterE -> 14 + Hex.CapitalLetterF -> 15 + Hex.SmallLetterA -> 10 + Hex.SmallLetterB -> 11 + Hex.SmallLetterC -> 12 + Hex.SmallLetterD -> 13 + Hex.SmallLetterE -> 14 + Hex.SmallLetterF -> 15 + +prop_integerHexCharMaybe :: Property +prop_integerHexCharMaybe = withTests 1 $ property $ + functionEq (liftA2 (,) every [-4 .. 20]) (uncurry Hex.integerHexCharMaybe) $ \case + (_, 0) -> Just Hex.Digit0 + (_, 1) -> Just Hex.Digit1 + (_, 2) -> Just Hex.Digit2 + (_, 3) -> Just Hex.Digit3 + (_, 4) -> Just Hex.Digit4 + (_, 5) -> Just Hex.Digit5 + (_, 6) -> Just Hex.Digit6 + (_, 7) -> Just Hex.Digit7 + (_, 8) -> Just Hex.Digit8 + (_, 9) -> Just Hex.Digit9 + (UpperCase, 10) -> Just Hex.CapitalLetterA + (UpperCase, 11) -> Just Hex.CapitalLetterB + (UpperCase, 12) -> Just Hex.CapitalLetterC + (UpperCase, 13) -> Just Hex.CapitalLetterD + (UpperCase, 14) -> Just Hex.CapitalLetterE + (UpperCase, 15) -> Just Hex.CapitalLetterF + (LowerCase, 10) -> Just Hex.SmallLetterA + (LowerCase, 11) -> Just Hex.SmallLetterB + (LowerCase, 12) -> Just Hex.SmallLetterC + (LowerCase, 13) -> Just Hex.SmallLetterD + (LowerCase, 14) -> Just Hex.SmallLetterE + (LowerCase, 15) -> Just Hex.SmallLetterF + _ -> Nothing + +prop_naturalD16Maybe :: Property +prop_naturalD16Maybe = withTests 1 $ property $ + functionEq [0 .. 20] Hex.naturalD16Maybe $ + I.injection I.linearSearchLazy every Hex.d16Natural + +prop_integerD16Maybe :: Property +prop_integerD16Maybe = withTests 1 $ property $ + functionEq [-4 .. 20] Hex.integerD16Maybe $ + I.injection I.linearSearchLazy every Hex.d16Integer + +prop_naturalD16Unsafe :: Property +prop_naturalD16Unsafe = withTests 1 $ property $ + functionEq [0 .. 15] + (Just . Hex.naturalD16Unsafe) + Hex.naturalD16Maybe + +prop_integerD16Unsafe :: Property +prop_integerD16Unsafe = withTests 1 $ property $ + functionEq [0 .. 15] + (Just . Hex.integerD16Unsafe) + Hex.integerD16Maybe + +prop_naturalHexCharUnsafe :: Property +prop_naturalHexCharUnsafe = withTests 1 $ property $ + functionEq (liftA2 (,) every [0 .. 15]) + (Just . uncurry Hex.naturalHexCharUnsafe) + (uncurry Hex.naturalHexCharMaybe) + +prop_integerHexCharUnsafe :: Property +prop_integerHexCharUnsafe = withTests 1 $ property $ + functionEq (liftA2 (,) every [0 .. 15]) + (Just . uncurry Hex.integerHexCharUnsafe) + (uncurry Hex.integerHexCharMaybe) + +prop_hex_showNatural_lower_12 :: Property +prop_hex_showNatural_lower_12 = withTests 1 $ property $ + Hex.showNatural LowerCase 12 === ("c" :: LBS.ByteString) + +prop_hex_showNatural_upper_10C :: Property +prop_hex_showNatural_upper_10C = withTests 1 $ property $ + Hex.showNatural UpperCase (256 + 12) === ("10C" :: BS.ByteString) + +prop_hex_showNatural_upper_0 :: Property +prop_hex_showNatural_upper_0 = withTests 1 $ property $ + Hex.showNatural UpperCase 0 === ("0" :: LBS.ByteString) + +prop_hex_showInteger_lower_12 :: Property +prop_hex_showInteger_lower_12 = withTests 1 $ property $ + Hex.showInteger LowerCase 12 === ("c" :: T.Text) + +prop_hex_showInteger_lower_minus12 :: Property +prop_hex_showInteger_lower_minus12 = withTests 1 $ property $ + Hex.showInteger LowerCase (negate 12) === ("-c" :: LT.Text) + +prop_hex_showInteger_upper_10C :: Property +prop_hex_showInteger_upper_10C = withTests 1 $ property $ + Hex.showInteger UpperCase (256 + 12) === ("10C" :: String) + +prop_hex_showInteger_upper_minus10C :: Property +prop_hex_showInteger_upper_minus10C = withTests 1 $ property $ + Hex.showInteger UpperCase (negate (256 + 12)) === ("-10C" :: BS.ByteString) + +prop_hex_showInteger_upper_0 :: Property +prop_hex_showInteger_upper_0 = withTests 1 $ property $ + Hex.showInteger UpperCase 0 === ("0" :: String) + +prop_hex_readNatural_5 :: Property +prop_hex_readNatural_5 = withTests 1 $ property $ + Hex.readNatural ("5" :: String) === Just 5 + +prop_hex_readNatural_minus5 :: Property +prop_hex_readNatural_minus5 = withTests 1 $ property $ + Hex.readNatural ("-5" :: T.Text) === Nothing + +prop_hex_readNatural_1f :: Property +prop_hex_readNatural_1f = withTests 1 $ property $ + Hex.readNatural ("1f" :: BS.ByteString) === Just 31 + +prop_hex_readNatural_1F :: Property +prop_hex_readNatural_1F = withTests 1 $ property $ + Hex.readNatural ("1F" :: LT.Text) === Just 31 + +prop_hex_readNatural_xa :: Property +prop_hex_readNatural_xa = withTests 1 $ property $ + Hex.readNatural ("xa" :: String) === Nothing + +prop_hex_readNatural_empty :: Property +prop_hex_readNatural_empty = withTests 1 $ property $ + Hex.readNatural ("" :: T.Text) === Nothing + +prop_hex_readInteger_5 :: Property +prop_hex_readInteger_5 = withTests 1 $ property $ + Hex.readInteger ("5" :: T.Text) === Just 5 + +prop_hex_readInteger_minus5 :: Property +prop_hex_readInteger_minus5 = withTests 1 $ property $ + Hex.readInteger ("-5" :: T.Text) === Just (-5) + +prop_hex_readInteger_1f :: Property +prop_hex_readInteger_1f = withTests 1 $ property $ + Hex.readInteger ("1f" :: LT.Text) === Just 31 + +prop_hex_readInteger_1F :: Property +prop_hex_readInteger_1F = withTests 1 $ property $ + Hex.readInteger ("1F" :: LT.Text) === Just 31 + +prop_hex_readInteger_xa :: Property +prop_hex_readInteger_xa = withTests 1 $ property $ + Hex.readInteger ("xa" :: String) === Nothing + +prop_hex_readInteger_empty :: Property +prop_hex_readInteger_empty = withTests 1 $ property $ + Hex.readInteger ("" :: String) === Nothing + +prop_hex_readInteger_minus :: Property +prop_hex_readInteger_minus = withTests 1 $ property $ + Hex.readInteger ("-" :: String) === Nothing + +prop_hex_readIntegral_word8_0014 :: Property +prop_hex_readIntegral_word8_0014 = withTests 1 $ property $ + Hex.readIntegral ("0014" :: String) === Just (20 :: Word8) + +prop_hex_readIntegral_word8_empty :: Property +prop_hex_readIntegral_word8_empty = withTests 1 $ property $ + Hex.readIntegral ("" :: String) === (Nothing :: Maybe Word8) + +prop_hex_readIntegral_word8_minus4 :: Property +prop_hex_readIntegral_word8_minus4 = withTests 1 $ property $ + Hex.readIntegral ("-4" :: String) === (Nothing :: Maybe Word8) + +prop_hex_readIntegral_word8_1234 :: Property +prop_hex_readIntegral_word8_1234 = withTests 1 $ property $ + Hex.readIntegral ("1234" :: String) === (Nothing :: Maybe Word8) + +checkReadShow :: forall string number f. + (Monad f, Eq number, Show number, Eq string, Show string) => + Gen number -> (number -> string) -> (string -> Maybe number) -> PropertyT f () +checkReadShow g s r = + do + x <- forAll g + r (s x) === Just x + +prop_readShow_dec_integer_text :: Property +prop_readShow_dec_integer_text = property $ + checkReadShow @T.Text @Integer genInteger Dec.showInteger Dec.readInteger + +prop_readShow_dec_integer_string :: Property +prop_readShow_dec_integer_string = property $ + checkReadShow @String @Integer genInteger Dec.showInteger Dec.readInteger + +prop_readShow_dec_integer_byteString :: Property +prop_readShow_dec_integer_byteString = property $ + checkReadShow @BS.ByteString @Integer genInteger Dec.showInteger Dec.readInteger + +prop_readShow_dec_natural :: Property +prop_readShow_dec_natural = property $ + checkReadShow @T.Text @Natural genNatural Dec.showNatural Dec.readNatural + +prop_readShow_dec_word8 :: Property +prop_readShow_dec_word8 = property $ + checkReadShow @T.Text @Word8 genWord8 Dec.showIntegral Dec.readIntegral + +prop_readShow_hex_integer_text :: Property +prop_readShow_hex_integer_text = property $ do + c <- forAll genCase + checkReadShow @T.Text @Integer genInteger (Hex.showInteger c) Hex.readInteger + +prop_readShow_hex_integer_string :: Property +prop_readShow_hex_integer_string = property $ do + c <- forAll genCase + checkReadShow @String @Integer genInteger (Hex.showInteger c) Hex.readInteger + +prop_readShow_hex_integer_byteString :: Property +prop_readShow_hex_integer_byteString = property $ do + c <- forAll genCase + checkReadShow @BS.ByteString @Integer genInteger (Hex.showInteger c) Hex.readInteger + +prop_readShow_hex_natural :: Property +prop_readShow_hex_natural = property $ do + c <- forAll genCase + checkReadShow @T.Text @Natural genNatural (Hex.showNatural c) Hex.readNatural + +prop_readShow_hex_word8 :: Property +prop_readShow_hex_word8 = property $ do + c <- forAll genCase + checkReadShow @T.Text @Word8 genWord8 (Hex.showIntegral c) Hex.readIntegral + +genNatural :: Gen Natural +genNatural = Gen.integral (Range.exponential 0 10000) + +genInteger :: Gen Integer +genInteger = Gen.integral (Range.exponentialFrom 0 (-10000) 10000) + +genWord8 :: Gen Word8 +genWord8 = Gen.integral (Range.linear minBound maxBound) + +genCase :: Gen Case +genCase = Gen.element [UpperCase, LowerCase]