Creating an answer of http://nabetani.sakura.ne.jp/hena/ord3ynode/ in Haskell

create.pl

use strict;
use warnings;

my %dfa = (
    BA => {
        r => 'AC',
        l => 'AD',
        b => 'AB',
    },
    AB => {
        r => 'BE',
        l => 'BC',
        b => 'BA',
    },
    AC => {
        r => 'CB',
        l => 'CF',
        b => 'CA',
    },
    CA => {
        r => 'AD',
        l => 'AB',
        b => 'AC',
    },
    BC => {
        r => 'CF',
        l => 'CA',
        b => 'CB',
    },
    CB => {
        r => 'BA',
        l => 'BE',
        b => 'BC',
    },
    BE => {
        r => 'ED',
        l => 'EF',
        b => 'EB',
    },
    EB => {
        r => 'BC',
        l => 'BA',
        b => 'BE',
    },
    CF => {
        r => 'FE',
        l => 'FD',
        b => 'FC',
    },
    FC => {
        r => 'CA',
        l => 'CB',
        b => 'CF',
    },
    AD => {
        r => 'DF',
        l => 'DE',
        b => 'DA',
    },
    DA => {
        r => 'AB',
        l => 'AC',
        b => 'AD',
    },
    DF => {
        r => 'FC',
        l => 'FE',
        b => 'FD',
    },
    FD => {
        r => 'DE',
        l => 'DA',
        b => 'DF',
    },
    DE => {
        r => 'EF',
        l => 'EB',
        b => 'ED',
    },
    ED => {
        r => 'DA',
        l => 'DF',
        b => 'DE',
    },
    EF => {
        r => 'FD',
        l => 'FC',
        b => 'FE',
    },
    FE => {
        r => 'EB',
        l => 'ED',
        b => 'EF',
    },
);

for my $st (keys %dfa) {
    my ($s, $t) = split //, $st, 2;
    for my $d (keys %{$dfa{$st}}) {
        my $n = (split //, $dfa{$st}{$d})[1];
        my $dire = {r => 'Right', l => 'Left ', b => 'Back '}->{$d};
        print "nextNode $s $t $dire = $n\n";
    }
}

ynode.hs

module Main where
import Control.Monad (join)
import Test.HUnit hiding (Node)
import Prelude hiding (Right, Left)

data Node = A | B | C | D | E | F deriving (Show, Eq)
data Direction = Right | Left | Back deriving Show

direction :: Char -> Direction
direction 'r' = Right
direction 'l' = Left
direction 'b' = Back
direction _ = error "No direction"

clockwiseRoutes :: [[Node]]
clockwiseRoutes = [
    [F, C, A, D]
  , [D, A, B, E]
  , [E, B, C, F]
  , [A, C, B]
  , [D, E, F]
  ]

searchRoute :: [[Node]] -> Node -> Node -> Node
searchRoute (x:xs) s t = let maybeNode = searchRoute' x s t
                          in case maybeNode of
                               Just node -> node
                               Nothing -> searchRoute xs s t
    where searchRoute' :: [Node] -> Node -> Node -> Maybe Node
          searchRoute' ys = searchRoute'' (last (init ys) : last ys : ys)
          searchRoute'' (z:z':z'':zs) s' t'
              | z == s' && z' == t' = Just z''
              | otherwise = searchRoute'' (z':z'':zs) s' t'
          searchRoute'' (_:_:[]) _ _ = Nothing
          searchRoute'' _ _ _ = error "[BUG]"
searchRoute [] s t = error $ "routes was not found for " ++ (show s)
                             ++ "->" ++ (show t)

nextNode :: Node -> Node -> Direction -> Node
nextNode s _ Back = s
nextNode s t Right = searchRoute clockwiseRoutes s t
nextNode s t Left  = searchRoute (reverse `fmap` clockwiseRoutes) s t

solve :: String -> String
solve input = join $ show `fmap` nodes
    where
      solve' :: Node -> Node -> [Direction] -> [Node]
      solve' _ t [] = [t]
      solve' s t (d:ds) = t : solve' t (nextNode s t d) ds
      nodes = solve' B A (direction `fmap` input)

main :: IO ()
main = do
  eachLines <- lines `fmap` readFile "ynode.tsv"
  patterns <- return $ split `fmap` eachLines
  tests <- return $ (TestCase . doAssert) `fmap` patterns
  runTestTT $ TestList tests
  return ()
    where split = (id >< tail) . break (== '\t')
          doAssert (input, expected) =
              assertEqual "" (solve input) expected
          (><) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
          (f >< g) (x, y) = (f x, g y)

{-
*Main> solve B A [Left, Left, Right, Right, Right]
[A,D,E,F,D,E]
-}

ynode.tsv