hear.hs

module Main where

import Text.Printf                -- import text formating function
import Data.Char                  -- import char functions

type Graph = [(String,[String])]

add_edge :: (String,String) -> Graph -> Graph
add_edge (s,d) [] = [(s,[d])]
add_edge (s,d) ((c,l):rest) =
  if s==c then (c,add d l):rest  else (c,l):(add_edge (s,d) rest)
    where
      add x [] = [x]
      add x (y:ys) = if x==y then y:ys else y:(add x ys)

adj :: String -> Graph -> [String]
adj _ [] = []
adj t ((s,l):xs) = if t==s then l else adj t xs

reachable :: (String,String) -> [String] -> Graph -> Bool
reachable (s,d) visited graph = (s==d) || any reach_d (adj s graph)
  where
    reach_d c  = (c `notElem` visited) && reachable (c,d) (s:visited) graph

f :: Graph -> [(String,String,Char)] -> [(String,String,Bool)]
f _graph [] = []
f  graph ((t1,t2,'.'):xs) = f (add_edge (t1,t2) graph) xs
f  graph ((t1,t2,'?'):xs) = (t1,t2,reachable (t1,t2) [] graph) : (f graph xs)

main :: IO()
main = interact (unlines . (map format) . f[] . (map parse) . lines)

isLetterInName c = isAlpha c || isDigit c || c=='_'

parse :: String -> (String, String, Char)
parse line = (t1,t2,c)
  where
    (t1,rest1) = span isLetterInName (dropWhile isSpace line)
    (t2,rest2) = span isLetterInName (dropWhile isSpace rest1)
    c:_        = dropWhile isSpace (rest2)

format :: (String, String, Bool) -> String
format (t1, t2, True)  = printf "+ %s => %s" t1 t2
format (t1, t2, False) = printf "- %s => %s" t1 t2