Solve PCP by BFS.

PCP.hs

module PCP where
import           Data.List
import           Data.Tree

-- breadth-first traversal
levelf :: Forest a -> [[a]]
levelf = unfoldr f
  where f [] = Nothing
        f xs = Just (map rootLabel xs, concat $ map subForest xs)

bftf :: Forest a -> [a]
bftf = concat . levelf

-- PCP
type Domino = (String, String)
type DominoDB = [Domino]
type DominoPath = [Domino]

buildForestFrom :: [(DominoPath, DominoDB)] -> Forest DominoPath
buildForestFrom = unfoldForest (\(path, db) -> (path, map (\x -> (path ++ [x], db)) db))

buildForest :: DominoDB -> Forest DominoPath
buildForest db = buildForestFrom $ map (\x -> ([x], db)) db

solve :: Int -> DominoDB -> DominoPath
solve n = head . filter p . take n . bftf . buildForest
  where p path = let (xs, ys) = unzip path
                 in concat xs == concat ys

main = do print $ solve 10000 [("b", "ca"),
                               ("a", "ab"),
                               ("ca", "a"),
                               ("abc", "c")]
--λ> main
--[("a","ab"),("b","ca"),("ca","a"),("a","ab"),("abc","c")]

Related tweets
https://twitter.com/chansey97/status/1262797584818556930