pairs' :: [a] -> [(a,a)] -> [(a,a)]
pairs' [] ys = ys
pairs' (x:xs) ys = pairs' xs (ys ++ map (x,) xs)

pairs :: [a] -> [(a,a)]
pairs xs = pairs' xs []

ordered :: Eq a => [(a,a)] -> [a] -> Bool
ordered ps xs = all (`elem` pairs xs) $ filter f ps
  where
    f (p,q) = p `elem` xs && q `elem` xs

parse :: String -> ([(Int,Int)], [[Int]])
parse s = (map pair ls, map list ks)
  where
    (ls,_:ks) = span (/= "") (lines s)
    pair r  = let (p,_:q) = span (/= '|') r in (read p, read q)
    list r  = read ("[" ++ r ++ "]") :: [Int]

corrects :: String -> [[Int]]
corrects s = let (ps,xss) = parse s in filter (ordered ps) xss

middle :: [a] -> a
middle xs = xs !! (length xs `div` 2)

doThing :: String -> Int
doThing = sum . map middle . corrects

main :: IO ()
main = getContents >>= print . doThing