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:  How to link two Types (David McBride)
   2. Re:  How to link two Types (PICCA Frederic-Emmanuel)
   3. Re:  How to link two Types (PICCA Frederic-Emmanuel)
   4. Re:  How to link two Types (PICCA Frederic-Emmanuel)
   5. Re:  Making a Tic-Tac-Toe Game (KC)
   6. Re:  Understanding the function monad ((->) r) (Michael Litchard)


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

Message: 1
Date: Wed, 22 Feb 2017 11:34:43 -0500
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] How to link two Types
Message-ID:
        <can+tr42a54aosg6fjmr+bse7db2jayw0jg054er4wwycdkx...@mail.gmail.com>
Content-Type: text/plain; charset=UTF-8

I should mention I just wrote that code off the cuff.  It's probably
not even close to right.  I recommend you mess with type families a
little to see if they get you where you want to go in your existing
code.

On Wed, Feb 22, 2017 at 11:29 AM, David McBride <toa...@gmail.com> wrote:
> It is hard to tell from your code what you intend, but it works
> however you want it to, so long as it type checks.
>
> class Frame a where
>   type Whatever a
>   len :: Whatever a -> IO (Maybe Int)
>   row :: Whatever a -> MaybeT IO (DifTomoFrame a DIM1)
>
> instance Frame DataFrameH5Path  where
>   type Whatever DataFrameH5Path = DataFrameH5
>   len = undefined -- :: DataFrameH5 -> IO (Maybe Int)
>   row = undefined -- :: DataFrameH5 -> Int -> MaybeT (DifTomoFrame
> DataFrameH5Path DIM1)
>
>
>
> On Wed, Feb 22, 2017 at 11:19 AM, PICCA Frederic-Emmanuel
> <frederic-emmanuel.pi...@synchrotron-soleil.fr> wrote:
>> Hello thanks, I will investigate, but I like this solution.
>> I can ad more type to a type family right ?
>>
>>
>> Is it possible with this type family to be able to link in the other way ?
>>
>> a -> t
>>
>> Cheers
>>
>> Fred
>> _______________________________________________
>> Beginners mailing list
>> Beginners@haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


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

Message: 2
Date: Wed, 22 Feb 2017 16:40:47 +0000
From: PICCA Frederic-Emmanuel
        <frederic-emmanuel.pi...@synchrotron-soleil.fr>
To: "The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell" <beginners@haskell.org>
Subject: Re: [Haskell-beginners] How to link two Types
Message-ID:
        
<a2a20ec3b8560d408356cac2fc148e53bb348...@sun-dag3.synchrotron-soleil.fr>
        
Content-Type: text/plain; charset="us-ascii"

> It is hard to tell from your code what you intend, but it works
> however you want it to, so long as it type checks.

> class Frame a where
>   type Whatever a
>   len :: Whatever a -> IO (Maybe Int)
>   row :: Whatever a -> MaybeT IO (DifTomoFrame a DIM1)

> instance Frame DataFrameH5Path  where
>   type Whatever DataFrameH5Path = DataFrameH5
>   len = undefined -- :: DataFrameH5 -> IO (Maybe Int)
>   row = undefined -- :: DataFrameH5 -> Int -> MaybeT (DifTomoFrame
> DataFrameH5Path DIM1)


In fact what I try realy to do is this.

data DataFrameH5Path
    = DataFrameH5Path
      (DataItem H5) -- image
      (DataItem H5) -- gamma
      (DataItem H5) -- delta
      (DataItem H5) -- wavelength
    deriving (Show)

data DataFrameH5 a
    = DataFrameH5
      (Nxs a) -- Nexus file
      (DataSource H5) -- gamma
      (DataSource H5) -- delta
      (DataSource H5) -- wavelength
      PoniGenerator -- ponie generator

withDataFrameH5 :: (Frame a, MonadSafe m) => File -> Nxs (Key a) -> 
PoniGenerator -> (a -> m r) -> m r
withDataFrameH5 h nxs'@(Nxs _ _ (DataFrameH5Path _ g d w)) gen = bracket 
(liftIO before) (liftIO . after)
  where
    -- before :: File -> DataFrameH5Path -> m DataFrameH5
    before :: IO a
    before =  DataFrameH5
              <$> return nxs'
              <*> openDataSource h g
              <*> openDataSource h d
              <*> openDataSource h w
              <*> return gen

    after :: a -> IO ()
    after (DataFrameH5 _ g' d' w' _) = do
      closeDataSource g'
      closeDataSource d'
      closeDataSource w'


I open and hdf5 file and I need to read a bunch of data from this file.
the DataFrameH5 is a sort of resource like a File handler.
I need a location in the file in order to acce the data, then I need to close 
the file
So I store in the H5 type these resource, that I can release at the end.


Ideally I would like to have only The H5Path type and hide the H5 one but I do 
not know how to do this.

I have in fact different H5Path types which necessitate each time there 
corresponding H5 type.

So I want a one for one relation between the H5 <-> H5Path type.


Cheers

Frederic

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

Message: 3
Date: Wed, 22 Feb 2017 16:41:19 +0000
From: PICCA Frederic-Emmanuel
        <frederic-emmanuel.pi...@synchrotron-soleil.fr>
To: "The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell" <beginners@haskell.org>
Subject: Re: [Haskell-beginners] How to link two Types
Message-ID:
        
<a2a20ec3b8560d408356cac2fc148e53bb348...@sun-dag3.synchrotron-soleil.fr>
        
Content-Type: text/plain; charset="us-ascii"

> I should mention I just wrote that code off the cuff.  It's probably
> not even close to right.  I recommend you mess with type families a
> little to see if they get you where you want to go in your existing
> code.

I am playing with it thanks :))


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

Message: 4
Date: Wed, 22 Feb 2017 17:19:10 +0000
From: PICCA Frederic-Emmanuel
        <frederic-emmanuel.pi...@synchrotron-soleil.fr>
To: "The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell" <beginners@haskell.org>
Subject: Re: [Haskell-beginners] How to link two Types
Message-ID:
        
<a2a20ec3b8560d408356cac2fc148e53bb349...@sun-dag3.synchrotron-soleil.fr>
        
Content-Type: text/plain; charset="us-ascii"

Hello, I am affected by this error

src/Hkl/Xrd/OneD.hs:238:49-52:
    Could not deduce (Key a ~ Key b0)
    from the context (Frame a)
      bound by the type signature for
                 getPoniExtRef :: Frame a => XRDRef (Key a) -> IO PoniExt
      at src/Hkl/Xrd/OneD.hs:235:18-56
    NB: `Key' is a type function, and may not be injective
    The type variable `b0' is ambiguous
    Possible fix: add a type signature that fixes these type variable(s)
    Expected type: Nxs (Key b0)
      Actual type: Nxs (Key a)
    In the second argument of `withDataFrameH5', namely nxs'
    In the first argument of `(>->)', namely
      `withDataFrameH5 h5file nxs' (gen output f) yield'
    In the first argument of `toListM', namely
      `(withDataFrameH5 h5file nxs' (gen output f) yield
        >-> hoist lift (frames' [idx]))'


I looked at this

http://stackoverflow.com/questions/20870432/type-family-vs-data-family-in-brief-haskell#20908500

So in your opinion it would be better to use a data family instead of a type 
familly ?



Cheers


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

Message: 5
Date: Wed, 22 Feb 2017 10:14:50 -0800
From: KC <kc1...@gmail.com>
To: Haskell Beginners <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Making a Tic-Tac-Toe Game
Message-ID:
        <CAMLKXymxsTjxypm0Hnr7b2sO=ztm86jtgx-qiknsacbfsgr...@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

If you want graphics there is
Making your first Haskell game
Which uses hGamer3D and aio

--
--

Sent from an expensive device which will be obsolete in a few months! :D

Casey


On Feb 21, 2017 8:36 AM, "Sudhanshu Jaiswal" <sudhanshuj...@gmail.com>
wrote:

> Also called as Noughts and crosses or Xs and Os.
>
> Hello everyone,
>
> How do I start making a *Two Player* Tic Tac Toe game in Haskell?
>
> The program basically has to show the 3*3 grid as coordinates and let each
> player choose his coordinates in his turn by entering the coordinates of
> the required cell. I also want to be able to check if a player has won and
> display it once the winning move has been made or the same for a Draw.
>
> What have I done? - I have read Learn You a Haskell till Modules and know
> basic I/O.
>
> I don't want the code instead, I am interested in learning stuff and
> trying problems which would lead me to get the intuition and ability to
> make the game by myself.
>
> I would be thankful if you folks could direct me to related problems which
> I could do or some advice as to how I should go about implementing such a
> program.
> --
> Sudhanshu
>
>
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://mail.haskell.org/pipermail/beginners/attachments/20170222/e5f806bc/attachment-0001.html>

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

Message: 6
Date: Wed, 22 Feb 2017 17:50:05 -0800
From: Michael Litchard <mich...@schmong.org>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Understanding the function monad
        ((->) r)
Message-ID:
        <caezekyrgn5k7q-leoeh3-rv3najgnv71fzg+dbyp9fvodda...@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

Thanks for this response. the Monad instance for ((->) r) has been bugging
me as well.

On Tue, Feb 21, 2017 at 6:32 AM, Rahul Muttineni <rahulm...@gmail.com>
wrote:

> Hi Olumide,
>
> Let the types help you out.
>
> The Monad typeclass (omitting the superclass constraints):
>
> class Monad m where
>   return :: a -> m a
>   (>>=) :: m a -> (a -> m b) -> m b
>
> Write out the specialised type signatures for (->) r:
>
> {-# LANGUAGE InstanceSigs #-}
> -- This extension allows you to specify the type signatures in instance
> declarations
>
> instance Monad ((->) r) where
>   return :: a -> (r -> a)
>   (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b)
>
> Now we look at how to make some definition of return that type checks.
> We're given an a and we want to return a function that takes an r and
> returns an a. Well the only way you can really do this is ignoring the r
> and returning the value you were given in all cases! Because 'a' can be
> *anything*, you really don't have much else you can do! Hence:
>
>   return :: a -> (r -> a)
>   return a = \_ -> a
>
> Now let's take a look at (>>=). Since this is a bit complicated, let's
> work backwards from the result type. We want a function that gives us a b
> given an r and given two functions with types (r -> a) and (a -> (r -> b)).
> To get a b, we need to use the second function. To use the second function,
> we must have an a, which we can get from the first function!
>
>   (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b)
>   (>>=) f g = \r -> (g (f r)) r
>
> Hope that helps!
> Rahul
>
>
> On Tue, Feb 21, 2017 at 5:04 PM, Olumide <50...@web.de> wrote:
>
>> On 21/02/2017 10:25, Benjamin Edwards wrote:
>>
>>> What is it that you are having difficulty with? Is it "why" this is a
>>> good definition? Is it that you don't understand how it works?
>>>
>>
>> I simply can't grok f (h w) w.
>>
>> - Olumide
>>
>> On Tue, 21 Feb 2017 at 10:15 Olumide <50...@web.de
>>> <mailto:50...@web.de>> wrote:
>>>
>>>     Hello List,
>>>
>>>     I am having enormous difficulty understanding the definition of the
>>> bind
>>>     operator of ((->) r) as show below and would appreciate help i  this
>>>     regard.
>>>
>>>     instance Monad ((->) r) where
>>>          return x = \_ -> x
>>>          h >>= f = \w -> f (h w) w
>>>
>>>     Thanks,
>>>
>>>     - Olumide
>>>
>>>     _______________________________________________
>>>     Beginners mailing list
>>>     Beginners@haskell.org <mailto: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
>>
>
>
>
> --
> Rahul Muttineni
>
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://mail.haskell.org/pipermail/beginners/attachments/20170222/8b2eeb7f/attachment.html>

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

Subject: Digest Footer

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


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

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

Reply via email to