import Data.Maybe
import Text.ParserCombinators.ReadP
import Data.List

type Nat = Int

-- Circuit Syntax:
-- <inPin>:[<gates>]:<outPin>
-- each Pin is either "X" (circuit IN or OUT)
--   or <gate-number> + ("L" | "R")
-- gates are numbered from 0
-- one gate is <inPinLeft><inPinRight>0#<outPinLeft><outPinRight>
--   obviously you specify the connector of the other side
--   (0 is probably the gate "function")
-- this contains redundancy ofc, it would be enough to specify only the in pins of the gates and the circuit OUT
--   (internal representation)

-- this is the gate function for "0#" (no other function found until now)
gate0 :: (Nat, Nat) -> (Nat, Nat)
gate0 (l,r) = (makef [0,2,1,1,0,2,2,1,0] (l,r), makef [2,2,2,2,0,1,2,1,0] (l,r))

-- helper to create gate functions
-- values for [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]
makef l x = fromJust $ lookup x $ zip [(i,j) | i <- [0..2], j <- [0..2]] l

--
execcirc :: Circuit -> [Nat]

key_circuit = parseCircuit key_circuit_str
key_circuit_str = "19L:12R13R0#1R12R,14R0L0#4R9L,9R10R0#3L8L,2L17R0#5L9R,15R1L0#10R13R,3L18R0#6L15L,5L11R0#13L12L,19R16R0#11R8R,2R7R0#11L10L,1R3R0#18L2L,8R4L0#16L2R,8L7L0#15R6R,6R0R0#14L0L,6L4R0#14R0R,12L13L0#17L1L,5R11L0#16R4L,10L15L0#17R7R,14L16L0#18R3R,9L17L0#19R5R,X18L0#X7L:19L"

-- goal: Find a circuit with test_key_circ circ == True
test_key_circ :: Circuit -> Bool
test_key_circ circ = (key == execcirc circ)
-- key: 11021210112101221

factory0 = parseCircuit "0L:X0R0#X0R:0L"
fact0_output = readstream "02120112100002120"
test0 = fact0_output == execcirc factory0

-- known server input stream (from factory "X::X")
input = readstream "01202101210201202"

data Circuit = Circuit { outPin :: Int, inPins :: [Int] } deriving (Eq)

instance Show Circuit where
	show = showCircuit

circfactory :: Circuit -> ([Nat], ([Nat], Nat) -> ([Nat], Nat))
circfactory circ = (map (const 0) (inPins circ), next) where
	next (pins, inp) = (pint, if (-1 == outPin circ) then inp else pint !! (outPin circ)) where
		pint = work 0 [] pins
		work _ n [] = n
		work k n o@(a:b:t) = let (c,d) = gate0 (get k, get (k+1)) in work (k+2) (n ++ [c,d]) t where
			get x = let r = (inPins circ !! x) in if (-1 == r) then inp else (n ++ o) !! r

showCircuit (Circuit op inpins) = (formatPin ip) ++ ":" ++ (joinWith "," (nodes inpins outpins)) ++ ":" ++ (formatPin op) where
	nodes :: [Nat] -> [Nat] -> [String]
	nodes [] [] = []
	nodes (a:b:i) (c:d:o) = ((formatPin a) ++ (formatPin b) ++ "0#" ++ (formatPin c) ++ (formatPin d)):nodes i o
	joinWith sep [] = []
	joinWith sep (x:xs) = (x ++) $ concat $ map (sep ++) xs
	-- build reverse pin mapping
	(ip:outpins) = map snd $ sort $ zip (op:inpins) [-1..]
	formatPin p = if (-1 == p) then "X" else (show (p `div` 2)) ++ (if even p then "L" else "R")

circ_from_perm (x:xs) = if (odd $ length xs) then error "Wrong pin count" else Circuit x xs

readPlace :: ReadP Int
readPlace = (char 'L' >> return 0) <++ (char 'R' >> return 1)

readInt :: ReadP Int
readInt = readS_to_P reads

readPin :: ReadP Int
readPin = (char 'X' >> return (-1)) <++ do
	i <- readInt
	p <- readPlace
	return $ (2*i) + p

readNode :: ReadP [Int]
readNode = do
	a <- readPin
	b <- readPin
	char '0'
	char '#'
	readPin
	readPin
	return [a,b]

readNodes1 :: ReadP [Int]
readNodes1 = (do
	char ','
	x <- readNode
	xl <- readNodes1
	return $ x ++ xl
	) <++ (return [])

readNodes :: ReadP [Int]
readNodes = (do
	x <- readNode
	xl <- readNodes1
	return $ x ++ xl
	) <++ (return [])


readCircuit :: ReadP Circuit
readCircuit = do
	readPin
	char ':'
	nodes <- readNodes
	char ':'
	outPin <- readPin
	return $ Circuit outPin nodes

doparse p s = fst $ head $ readP_to_S p s                                                                                                                                                                                                       
parseCircuit s = doparse readCircuit s

execfactory :: (a, (a, Nat) -> (a, Nat)) -> [Nat] -> [Nat]
execfactory (s, f) [] = []
execfactory (s, f) (x:xs) = o:execfactory (t, f) xs where (t, o) = f (s, x)

execcirc circ = execfactory (circfactory circ) input

readstream :: String -> [Int]
readstream = map (\c -> read [c] :: Int)

key_input = [0,2,2,2,2,2,2,0,2,1,0,1,1,0,0,1,1]
key = execfactory (circfactory key_circuit) key_input