module QIO.QExamples where

import Data.Monoid as Monoid
import QIO.QioSyn
import QIO.Qdata
import QIO.QioClass
import QIO.Qio


q0 :: QIO Qbit
q0 = mkQ False

q1 :: QIO Qbit
q1  =  mkQ True
          
qPlus :: QIO Qbit
qPlus  =  do  qa <- q0
              applyU (uhad qa)
              return qa

qMinus :: QIO Qbit
qMinus  =  do  qa <- q1
               applyU (uhad qa)
               return qa

randBit :: QIO Bool
randBit  =  do  qa <- qPlus
                x <- measQbit qa
                return x

share :: Qbit -> QIO Qbit
share  qa  =  do  qb <- q0
                  applyU (cond qa (\a -> if a then (unot qb)
                                              else (mempty)  )  )
                  return qb

bell :: QIO (Qbit, Qbit)
bell = do  qa <- qPlus
           qb <- share qa
           return (qa,qb)

test_bell :: QIO (Bool,Bool)
test_bell  =  do  qb <- bell
                  b <- measQ qb
                  return b

hadTwice :: Bool -> QIO Bool
hadTwice x = do q <- mkQ x
		applyU (uhad q `mappend` uhad q)
		b <- measQ q
		return b

hadTwice' :: Bool -> QIO Bool
hadTwice' x = do q <- mkQ x
	 	 applyU (uhad q)
                 applyU (uhad q)
		 b <- measQ q
		 return b

----------------------------------------------
---- Teleportation ---------------------------
----------------------------------------------

alice :: Qbit -> Qbit -> QIO (Bool,Bool)
alice aq eq  =  do  applyU (cond aq (\a -> if a then (unot eq)
                                              else (mempty)  )  )
                    applyU (uhad aq)
                    cd <- measQ (aq,eq)
                    return cd

uZZ :: Qbit -> U
uZZ qb = (uphase qb pi)

bobsU :: (Bool,Bool) -> Qbit -> U
bobsU  (False,False)  eq  =  mempty
bobsU  (False,True)  eq  =  (unot eq)
bobsU  (True,False)  eq  =  (uZZ eq)
bobsU  (True,True)  eq  =	     ((unot eq) 
       		    	   `mappend` (uZZ eq))

bob :: Qbit -> (Bool,Bool) -> QIO Qbit
bob eq cd  =  do  applyU (bobsU cd eq)
                  return eq

teleportation :: Qbit -> QIO Qbit
teleportation iq  =  do  (eq1,eq2) <- bell
                         cd <- alice iq eq1
                         tq <- bob eq2 cd
                         return tq

test_teleport :: QIO (Bool,Bool)
test_teleport = do (q1,q2) <- bell
                   tq2 <- teleportation q2
		   result <- measQ (q1,tq2)
		   return result

teleport_true' :: QIO Qbit
teleport_true' = do q <- q1
                    tq <- teleportation q
                    return tq

teleport_true :: QIO Bool
teleport_true = do q <- teleport_true'
                   result <- measQ q
                   return result

teleport_random' :: QIO Qbit
teleport_random' = do q <- qPlus
                      tq <- teleportation q
                      return tq

teleport_random :: QIO Bool
teleport_random = do q <- teleport_random'
                     result <- measQ q
                     return result

-----------------------------------------------
----- Deutsch's Algorithm ---------------------
-----------------------------------------------

u :: (Bool -> Bool) -> Qbit -> Qbit -> U
u f x y = cond x (\ b -> if f b then unot y else mempty)

deutsch :: (Bool -> Bool) -> QIO Bool
deutsch f = do
              x <- qPlus
              y <- qMinus
              applyU (u f x y)
              applyU (uhad x)
              measQ x

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

problem :: QIO Bool
problem = do q <- qPlus
             x <- measQ q
             if x then return x else problem
-- can be run returning True, but cannot be simulated!