Send Beginners mailing list submissions to
        beginners@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        beginners-requ...@haskell.org

You can reach the person managing the list at
        beginners-ow...@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1. Re:  Ambogous error in returning value (David McBride)
   2. Re:  Ambogous error in returning value (Baa)
   3.  Sequence function (Jimbo)
   4. Re:  Sequence function (David McBride)
   5. Re:  Sequence function (Jimbo)
   6. Re:  Sequence function (David McBride)


----------------------------------------------------------------------

Message: 1
Date: Tue, 26 Sep 2017 08:50:57 -0400
From: David McBride <toa...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Ambogous error in returning value
Message-ID:
        <CAN+Tr43RwL=qz1fyraw_9u9npu+u43mo07byv9vao3wcabc...@mail.gmail.com>
Content-Type: text/plain; charset="UTF-8"

The problem in the class is that it doesn't necessarily know that
(allows opts) and (crit a allows opts) necessarily are working on the
exact same Flt instance. (allows opts) could return [Foo], and but
crit is constrainted by the argument passed to it which is the a in
question.  The fact that there is only one possible instance right now
does not change the fact that there could be more in the future.
denied is already constrained because its return value is used as an
argument of crit.  To fix it

{-# LANGUAGE ScopedTypeVariables #-}
class Flt a where
    ....
    where
       allowed = if null $ (allows opts :: [a]) then True else a
`crit` (allows opts)
       denied = if null $ (denies opts :: [a]) then False else (a ::
a) `crit` (denies opts)

When you see an error Flt a1 does not match Flt a, that's a classic
sign that it doesn't know a1 and a are the same type.

As for the instance it has the exact same problem.  If you were to
pull allowed into its own function outside the class you could
constrain both functions at the same time, at the cost of some
verbosity.

{-# LANGUAGE ScopedTypeVariables #-}
class Flt a where
  ...
  flt opts a = allowed2 opts a && not denied

instance Flt MyType where
  ...
  flt opts a = allowed2 opts a && not denied

allowed2 :: forall a. Flt a => FltOpts -> a -> Bool
allowed2 opts a = if null $ (allows opts :: [a]) then True else a
`crit` (allows opts)


On Mon, Sep 25, 2017 at 6:06 AM, Baa <aqua...@gmail.com> wrote:
> Hello, everyone.
>
> Considering, I have a class:
>
>   class Flt a where
>     allows :: FltOpts -> [a]
>     denies :: FltOpts -> [a]
>     crit :: a -> [a] -> Bool
>     flt :: FltOpts -> a -> Bool
>     flt opts a = allowed && not denied
>       where allowed = if null $ allows opts then True else a `crit` (allows 
> opts)
>             denied = if null $ denies opts then False else a `crit` (denies 
> opts)
>
> I get error here:
>
>      • Could not deduce (Flt a1) arising from a use of ‘allows’
>        from the context: Flt a
>          bound by the class declaration for ‘Flt’
>          at .../.stack-work/intero/intero5319V42.hs:(31,1)-(38,97)
>        The type variable ‘a1’ is ambiguous
>        These potential instance exist:
>          instance Flt MyType
>            -- Defined at ...
>      • In the second argument of ‘($)’, namely ‘allows opts’
>        ....................................................
>
> As I understand, GHC can not deduce type if it's a return's value
> (contraposition?). OK, but it knows its type: it is `[a]`! What is the
> problem to keep `flt` method as a generic, i.e. without concreate type,
> but only `[a]` ?
>
> Second, I implemented instance:
>
>   instance Flt MyType where
>     allows = ...
>     denies = ...
>     flt opts a = allowed && not denied
>       where allowed = if null $ (allows opts::[MyType]) then True else a 
> `crit` (allows opts)
>             denied = if null $ (denies opts::[MyType]) then False else a 
> `crit` (denies opts)
>
> and without this explicite type annotation of `allows opts` I get again
> ambigous error. But why? GHC knows that `allows` returns `[a]` and `a`
> is `MyType`, so `[a]` is `[MyType]`. Why I need to write it explicitly?
> May be I need some extension here?
>
>
> ===
> Best regards, Paul
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

Message: 2
Date: Tue, 26 Sep 2017 16:12:35 +0300
From: Baa <aqua...@gmail.com>
To: beginners@haskell.org
Subject: Re: [Haskell-beginners] Ambogous error in returning value
Message-ID: <20170926161235.57109b95@Pavel>
Content-Type: text/plain; charset=US-ASCII

Hello, David!

Hmm, yes, I got it. Interesting is that I tried to set
explicitly types as `[a]` of `allows opts` and `denies opts` in the
class too (like in instance) but without this extension:

  {-# LANGUAGE ScopedTypeVariables #-}

and Intero nothing helps about "...do you want to include blah-blah,
press C-c C-r..." as usual it does it :)

OK, your explanation is absolutely enought. Thank you!

Have a nice day,


===
Best regards, Paul


------------------------------

Message: 3
Date: Tue, 26 Sep 2017 12:59:05 -0400
From: Jimbo <jimbo4...@gmail.com>
To: beginners@haskell.org
Subject: [Haskell-beginners] Sequence function
Message-ID: <eb727b25-8f30-d6ea-3bcc-aaf9a2504...@gmail.com>
Content-Type: text/plain; charset=utf-8; format=flowed

Hello everyone,

Just trying to understand the sequence function as follows:

sequence [Just 1]

-- evaluates to Just [1]

sequence = foldr mcons (return [])
     where mcons p q = p >>= \x -> q >>= \y -> return (x:y)

-- I'm trying to walk through the code as follows, I understand what is 
below isn't
-- haskell code

p >>= \x ->              []
q >>= \y ->        Just 1
return (x:y)    --  [] : Just 1

Am I thinking of sequence correctly here?

Best regards,

Jim



------------------------------

Message: 4
Date: Tue, 26 Sep 2017 13:49:24 -0400
From: David McBride <toa...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Sequence function
Message-ID:
        <CAN+Tr42AMycGYhdDWs0=Nqvp7FFdWsLsobPKxx-8fu4U=ww...@mail.gmail.com>
Content-Type: text/plain; charset="UTF-8"

Remember that foldr has flipped operator order from foldl.

>:t foldl
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
>:t foldr
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b

That means that you should expand them in the opposite order from how
it seems to read.

p >>= \x ->  -- Just 1 >>= \ 1
q >>= \y -> -- return [] >>= \ []
return (1 : []) -- Just [1]



On Tue, Sep 26, 2017 at 12:59 PM, Jimbo <jimbo4...@gmail.com> wrote:
> Hello everyone,
>
> Just trying to understand the sequence function as follows:
>
> sequence [Just 1]
>
> -- evaluates to Just [1]
>
> sequence = foldr mcons (return [])
>     where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
>
> -- I'm trying to walk through the code as follows, I understand what is
> below isn't
> -- haskell code
>
> p >>= \x ->              []
> q >>= \y ->        Just 1
> return (x:y)    --  [] : Just 1
>
> Am I thinking of sequence correctly here?
>
> Best regards,
>
> Jim
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

Message: 5
Date: Tue, 26 Sep 2017 14:10:32 -0400
From: Jimbo <jimbo4...@gmail.com>
To: beginners@haskell.org
Subject: Re: [Haskell-beginners] Sequence function
Message-ID: <be67b10f-8f9e-12a8-a182-cd1e9100b...@gmail.com>
Content-Type: text/plain; charset=utf-8; format=flowed

Thank you very much. Final question, in the line:

return (1 : []) -- Just [1]

Does the value ([1] in this case) get wrapped in Just because of the 
type signature of sequence? I.e

sequence :: Monad m => [m a] -> m [a]


On 26/09/2017 1:49 PM, David McBride wrote:
> Remember that foldr has flipped operator order from foldl.
>
>> :t foldl
> foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
>> :t foldr
> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
>
> That means that you should expand them in the opposite order from how
> it seems to read.
>
> p >>= \x ->  -- Just 1 >>= \ 1
> q >>= \y -> -- return [] >>= \ []
> return (1 : []) -- Just [1]
>
>
>
> On Tue, Sep 26, 2017 at 12:59 PM, Jimbo <jimbo4...@gmail.com> wrote:
>> Hello everyone,
>>
>> Just trying to understand the sequence function as follows:
>>
>> sequence [Just 1]
>>
>> -- evaluates to Just [1]
>>
>> sequence = foldr mcons (return [])
>>      where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
>>
>> -- I'm trying to walk through the code as follows, I understand what is
>> below isn't
>> -- haskell code
>>
>> p >>= \x ->              []
>> q >>= \y ->        Just 1
>> return (x:y)    --  [] : Just 1
>>
>> Am I thinking of sequence correctly here?
>>
>> Best regards,
>>
>> Jim
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners@haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners



------------------------------

Message: 6
Date: Tue, 26 Sep 2017 14:28:48 -0400
From: David McBride <toa...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Sequence function
Message-ID:
        <CAN+Tr4005Q54JQuAAyrR5G=kade4smtdwpxahfpd+xjaf-r...@mail.gmail.com>
Content-Type: text/plain; charset="UTF-8"

Monadic bind has this signature (Monad m => m a -> (a -> m b) -> m b.
Note that m is the same in both arguments and also the return value.

So when  you see p >>= \_ -> q ..., that means both p and q must be (m
Something), where the m is the same.

So when you go (Just 1 >>= \x -> return [] >>= \y -> return (x:y))
you know that return [] and return (x:y) are both using the Maybe
Monad instance because in Just 1, the m is Maybe.

So return [] is then equivalent to Just [], and return (x:y) is
equivalent to Just (x:y).  I hope that made sense.

On Tue, Sep 26, 2017 at 2:10 PM, Jimbo <jimbo4...@gmail.com> wrote:
> Thank you very much. Final question, in the line:
>
> return (1 : []) -- Just [1]
>
> Does the value ([1] in this case) get wrapped in Just because of the type
> signature of sequence? I.e
>
> sequence :: Monad m => [m a] -> m [a]
>
>
>
> On 26/09/2017 1:49 PM, David McBride wrote:
>>
>> Remember that foldr has flipped operator order from foldl.
>>
>>> :t foldl
>>
>> foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
>>>
>>> :t foldr
>>
>> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
>>
>> That means that you should expand them in the opposite order from how
>> it seems to read.
>>
>> p >>= \x ->  -- Just 1 >>= \ 1
>> q >>= \y -> -- return [] >>= \ []
>> return (1 : []) -- Just [1]
>>
>>
>>
>> On Tue, Sep 26, 2017 at 12:59 PM, Jimbo <jimbo4...@gmail.com> wrote:
>>>
>>> Hello everyone,
>>>
>>> Just trying to understand the sequence function as follows:
>>>
>>> sequence [Just 1]
>>>
>>> -- evaluates to Just [1]
>>>
>>> sequence = foldr mcons (return [])
>>>      where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
>>>
>>> -- I'm trying to walk through the code as follows, I understand what is
>>> below isn't
>>> -- haskell code
>>>
>>> p >>= \x ->              []
>>> q >>= \y ->        Just 1
>>> return (x:y)    --  [] : Just 1
>>>
>>> Am I thinking of sequence correctly here?
>>>
>>> Best regards,
>>>
>>> Jim
>>>
>>> _______________________________________________
>>> Beginners mailing list
>>> Beginners@haskell.org
>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners@haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
>
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

Subject: Digest Footer

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

End of Beginners Digest, Vol 111, Issue 17
******************************************

Reply via email to