{-# OPTIONS_GHC -fglasgow-exts #-}

-- a few examples of lambda-match use
-- needs syntax patch for lambda-match!

import ControlMonadMatch
import ControlMonadMatchInstances
import Control.Monad
import Prelude hiding(gcd)

-- case as syntactic sugar
a x = caseOf x $ (|True->"hi") +++ (|False->"ho")

-- lambda as syntactic sugar
myId :: a -> a
myId = splice (|x->x)

-- match failure from the do-notation, without do-notation
b x = return x >>= ok (|False-> return "hi")

-- if non-exhaustive functions were written as lambda-matches..
myHead :: Monad m => [a] -> Match m a
myHead = (|(h:_)->h)

use l = spliceE (myHead +++ matchError "empty list >here<") l

-- nesting matches
myAnd = splice $ (nest (|True->  (|True->True) 
                             +++ (|False->False)) )
             +++ (nest (|False-> fall_through False))

-- a couple of examples from the pattern guards thread

-- Conor's varVal example

-- we can separate the group of match alternatives from the uses
grp :: MonadPlus m => String -> [(String, String)] -> Match m String
grp = (|  x  locals | Just y <- lookup x locals -> y)
  +++ (| "X" locals -> "42")
  +++ matchError "var not found"

-- the original
varVal :: String -> [(String, String)] -> String
varVal  = spliceE grp

-- a variation 
varVals :: String -> [(String, String)] -> [] String
varVals  = allMatches grp

{- note how unreadable this would be without syntactic sugar

varVal :: String -> [(String, String)] -> String
varVal  = splice $
  (\x locals->Match $ do {Just y <- return $ lookup x locals; return y})
  +++
  (\x locals->Match $ do {"X" <- return x; return "42"})
  +++
  (\x locals->Match $ return (error "var not found"))
-}

-- Conor's gcd with inner case

-- his pseudo-syntax
{-
gcd x y | compare x y ->
  LT = gcd x (y - x)
  GT = gcd (x - y) y
gcd x _ = x
-}

-- the same with lambda-match and nested argument supply
gcd = splice $
      (nest (| x y ->compare x y >|
                          ((| LT -> gcd x (y - x))
                       +++ (| GT -> gcd (x - y) y))))
        +++ (| x y -> x)

-- as it happens, we're not doing any real matching 
-- at the outer level, so we can avoid "nest"
gcd' = splice $
      (\ x y ->compare x y >|
                  ((| LT -> gcd' x (y - x))
               +++ (| GT -> gcd' (x - y) y)))
  +++ (| x y -> x)

-- in fact, we can do with only one level of matching
gcd'' x y = caseOf (compare x y) $
                (| LT -> gcd'' x (y - x))
            +++ (| GT -> gcd'' (x - y) y)
            +++ (fall_through x)

-- David's mini-expect example
foo = splice $
      (| (Left "bar") -> "a")
  +++ (| (Right x) | (b," foo") <- break (==' ') x -> "b " ++ b)
  +++ (| (Left x)  | ("foo",c) <- break (==' ') x  -> "c " ++ c)
  +++ (| (Right x) | ["Hello",n,"how","are","you",d@(_:_)] <- words x,
                     last d == '?'
                   -> n ++ " is not here right now, but " ++ n 
                        ++ " is " ++ init d ++ " fine.")
  +++ (| (Left x)  | length x == 13 -> "Unlucky!")
  +++ (| (Right x) -> x)
  +++ (| (Left x)  -> x)

{- you do not want to write this without syntactic sugar..

foo :: Either String String -> String
foo = splice $
  (\it->Match $ do { Left "bar" <- return it; return "a"})
  +++
  (\it->Match $ do { Right x <- return it; (b," foo") <- return $ break (==' ') x; return $ "b " ++ b})
  +++
  (\it->Match $ do { Left x <- return it; ("foo",c) <- return $ break (==' ') x; return $ "c " ++ c})
  +++
  (\it->Match $ do { Right x <- return it; 
                   ["Hello",n,"how","are","you",d@(_:_)] <- return $ words x;
                   guard $ last d == '?';
                   return $ n ++ " is not here right now, but " ++ n 
                              ++ " is " ++ init d ++ " fine."})
  +++
  (\it->Match $ do { Left x <- return it; guard $ length x == 13; return "Unlucky!"})
  +++
  (\it->Match $ do { Right x <- return it; return x})
  +++
  (\it->Match $ do { Left x <- return it; return x})
-}