-- Note that this module depends on Quipper101. 
module Quipper102 where
import Quipper101
import System.Random
import Quipper
import Quipper.Libraries.Simulation

-- We can easily extend a single qubit teleportation to multi-qubit
-- teleportation.

-- map :: (a -> b) -> [a] -> [b]

my_map :: (a -> b) -> [a] -> [b]
my_map f [] = []
my_map f (x:xs) = f x : my_map f xs

my_sequence :: (Monad m) => [m a] -> m [a]
my_sequence [] = return []
my_sequence (x:xs) = do
  a <- x
  as <- my_sequence xs
  return (a:as)
  
-- sequence :: (Monad m) => [m a] -> m [a]

-- tele :: Qubit -> Circ Qubit
-- map tele :: [Qubit] -> [Circ Qubit]
multiTele :: [Qubit] -> Circ [Qubit]
multiTele l =
  sequence $ map tele l
  
  
multiTeleCirc :: IO ()
multiTeleCirc = print_generic Preview multiTele [qubit,qubit,qubit,qubit]


cnots :: [Qubit] -> Circ [Qubit]
cnots [] = return []
cnots (x:[]) = return [x]
cnots (x:y:xs) = do
  (y, x) <- controlled_not y x
  r <- cnots (y:xs)
  return (x:r)

cnotsCirc :: IO ()
cnotsCirc = print_generic Preview cnots [qubit,qubit,qubit,qubit]

  
ghz :: [Qubit] -> Circ [Qubit]
ghz [] = return []
ghz (x:xs) = do
  x <- hadamard x
  cnots (x:xs)

ghz' :: Int -> Circ [Qubit]
ghz' n = do
  input <- qinit $ replicate n False
  ghz input

ghzTest :: IO ()
ghzTest = print_generic Preview (ghz' 5)


testGHZ :: IO ()
testGHZ = do 
  let x = sim_generic (0.0 :: Double) (ghz' 50)
  putStrLn $ show x

ex_or :: Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
ex_or x y = do
  z <- qinit False
  z <- qnot z `controlled` x
  z <- qnot z `controlled` y
  return (x, y, z)

exOrCirc =
  print_generic Preview ex_or qubit qubit 

g :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit, Qubit, Qubit, Qubit, Qubit)
g x y z = do
  (x, y, q1) <- ex_or x y
  (x, z, q2) <- ex_or x z
  (y, z, q3) <- ex_or y z
  (x, q3, q4)<- ex_or x q3
  return (x, y, z, q1, q2, q3, q4)

gCirc =
  print_generic Preview g qubit qubit qubit
  
-- ccz using Clifford+T
ccz :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
ccz x y z = do
  with_computed (g x y z) b 
  where b (x, y, z, q1, q2, q3, q4) = do
          x <- gate_T x
          y <- gate_T y
          z <- gate_T z
          q1 <- gate_T_inv q1
          q2 <- gate_T_inv q2
          q3 <- gate_T_inv q3
          q4 <- gate_T q4
          return (x, y, z)

cczCirc =
  print_generic Preview ccz qubit qubit qubit
          
-- from ccz to ccx
toffoli :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)
toffoli x y z = do
  z <- hadamard z
  (x, y, z) <- ccz x y z
  z <- hadamard z
  return (x,y,z)

toffoliCirc =
  print_generic Preview toffoli qubit qubit qubit

testToffoli :: IO ()
testToffoli = do 
  let x = sim_generic (0.0 :: Double) toffoli
           True True True
  putStrLn $ show x