diff --git a/pos.cabal b/pos.cabal --- a/pos.cabal +++ b/pos.cabal @@ -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 maintainer: Grant Weyburne 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: diff --git a/src/Data/Pos.hs b/src/Data/Pos.hs --- a/src/Data/Pos.hs +++ b/src/Data/Pos.hs @@ -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" diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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}"