module TestVariant

imports
  Prelude

where

main :: () -> I32
main () = do
  testEnum ()
  testNewtype ()
  testNewtypePoly ()
  testUnit ()
  testVariant ()
  0

type Color = | Red | Blue | Green // the standard enum example, order doesn't matter

type PHColor x = | PHRed | PHBlue // phantom type enum

instance Eq Color // eq and ne can be derived for enums
instance Eq (PHColor x)

// enums can't be automatically cast to ints, that leads to maintenance problems
unColor :: Color -> W32
unColor c = switch c of
  Red -> 0
  Blue -> 1
  Green -> 2 // All tags must be matched.  Removing this line will cause a compile time error.

sColor :: Color -> IString
sColor c = switch c of // switch on enums is by value
  Red -> "Red"
  Blue -> "Blue"
  Green -> "Green"

type Unit = | Unit // singleton type, isomorphic to ()

unitf :: () -> Unit
unitf () = Unit

unita :: Unit -> ()
unita _ = () // todo(?): unita Unit = ()

testUnit :: () -> ()
testUnit () = do
  putLn "testunit"
  x = Unit // singleton types are compiled into "void" in LLVM/C
  unita x
  _ = unitf ()
  unita Unit
  putLn "done"

testEnum :: () -> ()
testEnum () = do
  putLn "testEnum"
  assert (Red == Red)
  x = Green // enum types are compiled into unsigned ints in LLVM/C
  putLn (sColor x)
  assert (Green == x)
  assert (x == Green)
  assert (x != Blue)
  p = new Blue
  assert (@p == Blue)
  putLn (sColor @p)
  p <- Red
  assert (@p != Blue)
  putLn (sColor @p)
  p <- x
  putLn (sColor @p)
  assert (@p == Green)
  assert (unColor @p == 2)
  assert (unColor Blue == 1)
  switch Red of
    Green -> assert False
    Red -> assert True
    color -> assert (color != Blue)
  switch x of
    Green -> assert True
    Red -> assert False
    Blue -> assert False
  pc = (PHRed :: PHColor Bool)
  assert (pc == PHRed)
//  assert (pc == (PHRed :: PHColor ())) // type error
  putLn "done"

type Meters = | M W32 // newtype.  A variant with only one tag

instance Eq Meters

testNewtype :: () -> ()
testNewtype () = do
  putLn "testNewtype"
  assert (M 7 == M 7)
// newtypes are constructed by juxtaposition like in Haskell
// newtypes are compiled into whatever the underlying type is in LLVM/C (i.e. the tag is eliminated)
  x = M 12
  assert (x == M 12)
  p = new (M 7)
  assert (@p != M 12)
  assert (@p == M 7)
  p <- M 47
  assert (@p == M 47)
  assert (47 == m_unwrap @p) // instead of using "case" to extract values from newtypes, a function is created which will unwrap the type, it has the form <constr>_unwrap.  Also <constr>_unwrapptr is created which will safely cast a newtype ptr to a ptr.
  p <- M 1
  i = m_unwrap @p
  assert (i == 1)
  putLn "done"

type MyA a = | My a // polymorphic newtype

testNewtypePoly :: () -> ()
testNewtypePoly () = do
  putLn "testNewtypePoly"
  x = My 'c'
  p = new x
  assert (my_unwrap @p == 'c')
  q = new (My True)
  assert (my_unwrap @q)
  putLn "done"

testVariant :: () -> ()
testVariant () = do
  putLn "testVariant"
  p = new (Left False)
  p <- Right 'c' // p :: Ptr (Either Bool Char)
  // variants must be accessed via a pointer
  case p of
    Left a -> do
      assert @a
    Right b -> do // b :: Ptr Char, not Char
      putCh @b
      assert (@b == 'c')
  p <- Left True // store the value "Left True" in p
  case p of
    Left a -> assert @a
    Right b -> do
      putCh @b
      assert False
  q = new (Nothing :: Maybe Bool)
  case q of
    Nothing -> assert True
    Just _ -> assert False
  q <- Just True
  case q of
    Just b -> assert @b
    _ -> assert False
  r = new (Left True)
  case r of
    Left b -> assert @b
    Right _ -> assert False
  r <- Right (27 :: W32)
  case r of
    Left _ -> assert False
    Right i -> do
      putW @i
      assert True
  putLn "done"