[Haskell-cafe] a really juvenile question .. hehehehe ;^)

Johan Tibell johan.tibell at gmail.com
Mon Oct 6 03:04:16 EDT 2008


2008/10/6 Galchin, Vasili <vigalchin at gmail.com>:
> ok ... by using "newtype", we are constricting/constraining to a subset of
> CInt .. e.g. something like a "subtype" of CInt?? (where by "subtype", I
> mean like the notion of subtype in languages like Ada). For our audience,
> can you perhaps distinguish (in a typeful way) between the Haskell notion of
> "type", "newtype" and "data"? Or maybe let's distinguish between these
> notions not only in a typeful manner, but also in a historical motivation?
> .. ...  motivations are always IMO very, very enlightening!

Here's an example of using newtypes:

module Main where

newtype Flag = Flag Int

-- These are the only legal values:
flag1 :: Flag
flag1 = Flag 1

flag2 :: Flag
flag2 = Flag 2

fun :: Int -> Flag -> Int
fun n (Flag f) = undefined  -- Implementation goes here.

-- Using `fun`.

main = do
  print (fun 10 flag1)
  -- Oh noes, the programmer messed up and reordered the
  -- arguments!
  print (fun flag1 10)

Saved by the type checker:

/home/tibell/Test.hs:21:13:
    Couldn't match expected type `Int' against inferred type `Flag'
    In the first argument of `fun', namely `flag1'
    In the first argument of `print', namely `(fun flag1 10)'
    In the expression: print (fun flag1 10)
Failed, modules loaded: none.

By creating a module that doesn't export the constructor used to
create e.g. `Flag` and only the constants `flag1` and `flag2` we can
make sure that no one ever calls `fun` with an illegal value.

I hope this helps.

Cheers,

Johan


More information about the Haskell-Cafe mailing list