pos 0.2.0.0 → 0.3.0.0
raw patch · 3 files changed
+36/−44 lines, 3 files
Files
- pos.cabal +3/−3
- src/Data/Pos.hs +26/−34
- test/Main.hs +7/−7
pos.cabal view
@@ -5,12 +5,12 @@ -- see: https://github.com/sol/hpack name: pos-version: 0.2.0.0+version: 0.3.0.0 synopsis: positive numbers description: A library for representing positive integers. . Useful for handling nonempty containers and fixed containers. category: Data, Numeric homepage: https://github.com/gbwey/pos#readme-bug-reports: https://github.com/gbwey/pos.git/issues+bug-reports: https://github.com/gbwey/pos/issues author: Grant Weyburne <gbwey9@gmail.com> maintainer: Grant Weyburne <gbwey9@gmail.com> copyright: 2022 Grant Weyburne@@ -20,7 +20,7 @@ source-repository head type: git- location: https://github.com/gbwey/pos.git+ location: https://github.com/gbwey/pos library exposed-modules:
src/Data/Pos.hs view
@@ -64,23 +64,17 @@ divModP, divModNextP, maxP,-- -- ** enums predP, succP,- posRange, -- ** type level- type PosT,- fromN,- fromNP,+ PosC (..), NS (..), -- ** miscellaneous-- -- _Pos, fromPositives, toPositives,+ posRange, -- * parsers pPositives,@@ -116,7 +110,7 @@ deriving newtype (NFData) instance Show Pos where- showsPrec _ (Pos i) = showsPrec 11 i . showChar 'P'+ showsPrec _ (Pos i) = showChar '_' . showsPrec 11 i . showChar 'P' -- | readonly pattern synonym for 'Pos' {-# COMPLETE Pos #-}@@ -127,17 +121,20 @@ -- | parser for an 'Int' pInt :: P.ReadP Int pInt = do- P.skipSpaces ii <- P.many1 (P.satisfy isDigit) maybe P.pfail pure (readMaybe @Int ii) -- | parser for a 'Pos' pPos :: P.ReadP Pos-pPos = pPosInt <* P.char 'P'+pPos = P.skipSpaces *> P.char '_' *> pPosInt' <* P.char 'P' --- | parser for an int converted positive number+-- | parser for a 'Pos' but just reading in a positive number pPosInt :: P.ReadP Pos-pPosInt = do+pPosInt = P.skipSpaces *> pPosInt'++-- | parser for an int converted positive number+pPosInt' :: P.ReadP Pos+pPosInt' = do i <- pInt either (const empty) return (eitherPos i) @@ -245,32 +242,27 @@ predP (Pos n) = eitherPos (n - 1) {-# INLINE predP #-} --- | converts a restricted (positive) 'Nat' to an 'Int'-fromN :: forall n. PosT n => Int-fromN = pnat @n-{-# INLINE fromN #-}---- | converts a 'Nat' to a 'Pos'-fromNP :: forall n. PosT n => Pos-fromNP = case eitherPos $ pnat @n of- Left e -> error $ "fromNP:" ++ e -- shouldnt fail because of PosT constraint- Right p -> p-{-# INLINE fromNP #-}- -- | extract an 'Int' from a 'Nat' pnat :: forall n. GL.KnownNat n => Int pnat = fromInteger (GL.natVal (Proxy @n)) --- | constraint that limits to positive 'Nat'-type PosT :: Nat -> Constraint-type PosT n =+-- | constraint for positive numbers+type PosC :: Nat -> Constraint+class KnownNat n => PosC n where+ fromNP :: Pos+ fromN :: Int+ fromN = unP (fromNP @n)+instance ( KnownNat n , FailUnless (1 GL.<=? n)- ( 'GL.Text "PosT n: requires n >= 1 but found "+ ( 'GL.Text "PosC n: requires n >= 1 but found " 'GL.:<>: 'GL.ShowType n )- )+ ) =>+ PosC n+ where+ fromNP = unsafePos "fromN" (pnat @n) type FailUnless :: Bool -> GL.ErrorMessage -> Constraint type family FailUnless b err where@@ -288,15 +280,15 @@ instance GL.TypeError ( 'GL.Text "NS: empty dimensions are not supported") => NS '[] where fromNSP = error "fromNSP: should not be here" nsLengthP = error "fromNSP: should not be here"-instance PosT n => NS '[n] where+instance PosC n => NS '[n] where fromNSP = fromNP @n :| [] nsLengthP = _1P-instance (PosT n, NS (n1 ': ns)) => NS (n ': n1 ': ns) where+instance (PosC n, NS (n1 ': ns)) => NS (n ': n1 ': ns) where fromNSP = fromNP @n N.<| fromNSP @(n1 ': ns) nsLengthP = succP (nsLengthP @(n1 ': ns)) -- | construct a valid 'Pos' using a 'Nat'-_P :: forall n. PosT n => Pos+_P :: forall n. PosC n => Pos _P = Pos' (pnat @n) -- | converts a container of positives to a list of ints@@ -308,7 +300,7 @@ toPositives is = do ps <- traverse eitherPos (toList is) case ps of- [] -> Left "empty"+ [] -> Left "toPositives: empty" x : xs -> Right (x :| xs) -- | enumerate a nonempty list of 'Pos' from "i" to "j"
test/Main.hs view
@@ -33,15 +33,15 @@ , testCase "productP" $ productP (_4P :| []) @?= _4P , testCase "productP" $ productP [_4P, _5P] @?= _P @20 , testCase "productP" $ productP [_4P] @?= _4P- , testCase "read" $ unP (read @Pos "1325P") @?= 1325- , testCase "read" $ read @Pos "1325P" @?= _P @1325- , testCase "show" $ show (_P @1325) @?= "1325P"+ , testCase "read" $ unP (read @Pos "_1325P") @?= 1325+ , testCase "read" $ read @Pos "_1325P" @?= _P @1325+ , testCase "show" $ show (_P @1325) @?= "_1325P" , testCase "read/show" $ read @Pos (show (_P @1325)) @?= _P @1325 , testCase "reads 0" $ reads @Pos "0P" @?= [] , testCase "reads -4" $ reads @Pos "-4P" @?= [] , testCase "reads space between" $ reads @Pos " 9 P" @?= []- , testCase "reads leading spaces and extra" $ reads @Pos " 9P xyz" @?= [(_9P, " xyz")]- , testCase "reads leading spaces and extra" $ reads @Pos " 123P" @?= [(_P @123, "")]+ , testCase "reads leading spaces and extra" $ reads @Pos " _9P xyz" @?= [(_9P, " xyz")]+ , testCase "reads leading spaces and extra" $ reads @Pos " _123P" @?= [(_P @123, "")] , testCase "fromNSP" $ fromNSP @'[4] @?= (_4P :| []) , testCase "fromNSP" $ fromNSP @'[4, 6, 3] @?= (_4P :| [_6P, _3P]) , testCase "fromNP 1" $ fromNP @1 @?= _1P@@ -76,7 +76,7 @@ P.readP_to_S pPosInt " 12xyz" @?= [(_1P, "2xyz"), (_12P, "xyz")] -- ambiguous , testCase "pPos" $- P.readP_to_S pPos " 12Pxyz"+ P.readP_to_S pPos " _12Pxyz" @?= [(_12P, "xyz")] , testCase "pPosInt" $ P.readP_to_S pPosInt " 10xyz"@@ -85,7 +85,7 @@ P.readP_to_S pPosInt " 023xyz" @?= [(_2P, "3xyz"), (_P @23, "xyz")] , testCase "pPos" $- P.readP_to_S pPos " 12P xyz"+ P.readP_to_S pPos " _12P xyz" @?= [(_12P, " xyz")] , testCase "readP pPositives" $ P.readP_to_S ((,) <$> pInt <* P.char '@' <*> pPositives '{' '}') "1444@{1}"