Coded (dead end)

Coded.hs

{-# LANGUAGE DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
module Coded where

import Control.Unification
import Control.Unification.IntVar
import Control.Monad.Logic
import Data.Functor.Fixedpoint
import Data.List
import Data.Foldable
import Data.Traversable

data TermF r = C Char
             | L [r]
             | P r r
   deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

type Term = Fix TermF

instance Unifiable TermF where
  zipMatch (C a)  (C b) | a == b = Just $ C a
  zipMatch (L as) (L bs) | length as == length bs = Just $ L $ zip as bs
  zipMatch (P a1 b1) (P a2 b2) = Just $ P (a1, a2) (b1, b2)
  zipMatch _ _ = Nothing

main = do
  let ps = solve ["a"] ["1"]
  print ps

solve :: [String]-> [String] -> String
-- solve _ _ = [('a', '1')]
solve ws ds = pretty . observe . evalIntBindingT $ solve1 (parse ws) (parse ds) 

type Solver a = IntBindingT TermF Logic a

solve1 :: Term -> Term -> Solver Term
solve1 wt dt = undefined

parse :: [String] -> Term
parse = Fix . L . map parseWord
  where parseWord = Fix . L . map (Fix . C)

pretty :: Term -> String
pretty = cata trans
  where trans (C c) = [c]
        trans (L ss) = intercalate ", " ss
        trans (P s1 s2) = s1++"="++s2