author David Luposchainsky Fri, 11 Aug 2017 11:46:13 +0000 (13:46 +0200) committer Ben Gamari Thu, 17 Aug 2017 20:42:55 +0000 (16:42 -0400)

index fd7c677..dd51f64 100644 (file)
@@ -161,8 +161,6 @@ instance Alternative P where

newtype ReadP a = R (forall b . (a -> P b) -> P b)

--- Functor, Monad, MonadPlus
-
-- | @since 2.01
instance Functor ReadP where
fmap h (R f) = R (\k -> f (k . h))
@@ -171,7 +169,7 @@ instance Functor ReadP where
instance Applicative ReadP where
pure x = R (\k -> k x)
(<*>) = ap
-    liftA2 = liftM2
+    -- liftA2 = liftM2

-- | @since 2.01
instance Monad ReadP where
@@ -439,85 +437,68 @@ The following are QuickCheck specifications of what the combinators do.
These can be seen as formal specifications of the behavior of the
combinators.

-We use bags to give semantics to the combinators.
+For some values, we only care about the lists contents, not their order,

->  type Bag a = [a]
+> (=~) :: Ord a => [a] -> [a] -> Bool
+> xs =~ ys = sort xs == sort ys

-Equality on bags does not care about the order of elements.
+Here follow the properties:

->  (=~) :: Ord a => Bag a -> Bag a -> Bool
->  xs =~ ys = sort xs == sort ys
+>>> readP_to_S get []
+[]

-A special equality operator to avoid unresolved overloading
-when testing the properties.
+prop> \c str -> readP_to_S get (c:str) == [(c, str)]

->  (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
->  (=~.) = (=~)
+prop> \str -> readP_to_S look str == [(str, str)]

-Here follow the properties:
+prop> \str -> readP_to_S pfail str == []

->  prop_Get_Nil =
->    readP_to_S get [] =~ []
->
->  prop_Get_Cons c s =
->    readP_to_S get (c:s) =~ [(c,s)]
->
->  prop_Look s =
->    readP_to_S look s =~ [(s,s)]
->
->  prop_Fail s =
->    readP_to_S pfail s =~. []
->
->  prop_Return x s =
->    readP_to_S (return x) s =~. [(x,s)]
->
->  prop_Bind p k s =
->    readP_to_S (p >>= k) s =~.
+prop> \x str -> readP_to_S (return x) s == [(x,s)]
+
+> prop_Bind p k s =
+>    readP_to_S (p >>= k) s =~
>      [ ys''
>      | (x,s') <- readP_to_S p s
>      , ys''   <- readP_to_S (k (x::Int)) s'
>      ]
->
->  prop_Plus p q s =
->    readP_to_S (p +++ q) s =~.
->      (readP_to_S p s ++ readP_to_S q s)
->
->  prop_LeftPlus p q s =
->    readP_to_S (p <++ q) s =~.
->      (readP_to_S p s +<+ readP_to_S q s)
->   where
->    [] +<+ ys = ys
->    xs +<+ _  = xs
->
->  prop_Gather s =
->    forAll readPWithoutReadS \$ \p ->
->      readP_to_S (gather p) s =~
->        [ ((pre,x::Int),s')
->        | (x,s') <- readP_to_S p s
->        , let pre = take (length s - length s') s
->        ]
->
->  prop_String_Yes this s =
->    readP_to_S (string this) (this ++ s) =~
->      [(this,s)]
->
->  prop_String_Maybe this s =
->    readP_to_S (string this) s =~
->      [(this, drop (length this) s) | this `isPrefixOf` s]
->
->  prop_Munch p s =
->    readP_to_S (munch p) s =~
->      [(takeWhile p s, dropWhile p s)]
->
->  prop_Munch1 p s =
->    readP_to_S (munch1 p) s =~
->      [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
->
->  prop_Choice ps s =
->    readP_to_S (choice ps) s =~.
->      readP_to_S (foldr (+++) pfail ps) s
->
->  prop_ReadS r s =
->    readP_to_S (readS_to_P r) s =~. r s
--}

+> prop_Plus p q s =
+>   readP_to_S (p +++ q) s =~
+>     (readP_to_S p s ++ readP_to_S q s)
+
+> prop_LeftPlus p q s =
+>   readP_to_S (p <++ q) s =~
+>     (readP_to_S p s +<+ readP_to_S q s)
+>  where
+>   [] +<+ ys = ys
+>   xs +<+ _  = xs
+
+> prop_Gather s =
+>   forAll readPWithoutReadS \$ \p ->
+>     readP_to_S (gather p) s =~
+>       [ ((pre,x::Int),s')
+>       | (x,s') <- readP_to_S p s
+>       , let pre = take (length s - length s') s
+>       ]
+
+prop> \this str -> readP_to_S (string this) (this ++ str) == [(this,str)]
+
+> prop_String_Maybe this s =
+>   readP_to_S (string this) s =~
+>     [(this, drop (length this) s) | this `isPrefixOf` s]
+
+> prop_Munch p s =
+>   readP_to_S (munch p) s =~
+>     [(takeWhile p s, dropWhile p s)]
+
+> prop_Munch1 p s =
+>   readP_to_S (munch1 p) s =~
+>     [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
+
+> prop_Choice ps s =
+>   readP_to_S (choice ps) s =~
+>     readP_to_S (foldr (+++) pfail ps) s
+
+> prop_ReadS r s =
+>   readP_to_S (readS_to_P r) s =~ r s
+-}