import Data.Char(toLower)
import System.Environment(getArgs)
import qualified Data.Set as Set 
import System.IO(hPutStrLn, stderr)
import System.Exit(exitFailure)
import Data.List as List
import Control.Parallel.Strategies hiding(parMap)
import Control.DeepSeq



type StringSet = Set.Set String
parMap :: (a -> b) -> [a] -> Eval [b]
parMap _ [] = return []
parMap f (a:as) = do
    b <- rpar (f a)
    bs <- parMap f as
    return (b:bs)

-- pmap :: (a -> b) -> [a] -> [b]
-- pmap f xs = map f xs `using` parList rseq


-- concatMap1              :: (a -> [b]) -> [a] -> [b]
-- concatMap1 f xs         =  concat $ pmap f xs

-- usage :: IO ()
-- usage = do 
-- 	pn <- getProgName
-- 	die $ "Usage: " ++ pn ++ " <dictionary-filename> <from-word> <to-word>"

readDict :: String -> Int -> IO StringSet
readDict filename _ = 
  (Set.fromList . (map (map toLower)) . words) `fmap` readFile filename


search :: StringSet -> String -> String -> Int -> Maybe [String]
search dictionary fromWord toWord maxDepth = 
  bfs [[fromWord]] (Set.singleton fromWord) maxDepth
  where
  	bfs :: [[String]] -> StringSet -> Int -> Maybe [String]
  	bfs _ _ 0 = Nothing
  	bfs paths visited depth =
  		case filter ((==toWord) . head) paths of
  			(solution:_) -> Just solution
  			[] -> bfs paths'' visited' (depth - 1)
              where
               paths' = concat $ runEval $ parMap takeAStep paths
               (paths'', visited') = foldr validStep ([], visited) paths'
               validStep np@(w:_) (existing, v)
                  | not (Set.member w v)
                        = (np : existing, Set.insert w v)
                  | otherwise = (existing, v)
               validStep [] _ = error "validStep: empty list?"
               takeAStep :: [String] -> [[String]]
               takeAStep [] = error "takeAStep: empty list?"
               takeAStep p@(x:_) = concat $ runEval $ parMap allletters $ zip (inits x) (tails x)
--               takeAStep p@(x:_) = concat $ zipWith (allletters) (inits x) (tails x)
                 where
                   -- pair = zip (inits x) (tails x)
                   -- helper p = zip (map fst p) (map (tail . snd) (init p))
                   allletters (pre,w@(_:ws)) =runEval $ do
                                                as' <- rpar (force (generateNextHop pre w))
                                                bs' <- rpar (force (generateNextHop pre ws))
                                                rseq as'
                                                rseq bs'
                                                return (as' ++ bs')
                   allletters (_,[]) = []
--                   allletters pre w@(_:ws) = runEval $ do
--                                                    as' <- rpar (force (generateNextHop pre w))
--                                                    bs' <- rpar (force (generateNextHop pre ws))
--                                                    rseq as'
--                                                    rseq bs'
--                                                    return (as' ++ bs')
--                   allletters _ [] = []
                   generateNextHop pre w = [ b : p | c <- ['a'..'z'], let b = (pre ++ [c] ++ w), Set.member b dictionary, not $ Set.member b visited]
maxSteps :: Int 
maxSteps = 200

main :: IO ()
main = do args <- getArgs
          case args of
            [filename, start, end] -> do
               contents <- readDict filename (length start)
               case search contents start end maxSteps of
               	Nothing -> putStrLn "no ladder"
               	Just _ -> putStrLn "parallelized"
               
            _ -> do 
              -- pn <- getProgName 
                    hPutStrLn stderr $ "Usage: wordLadder <dictionary-filename> <from-word> <to-word>"
                    exitFailure 