import Data.Char
import Data.List
import Data.List.Split
import Data.Maybe
import System.Environment
import System.Cmd
import System.Exit

main =
 do rs <- mapM doModule =<< getArgs
    putStrLn $ "Failures: " ++ (unwords $ mapMaybe fromLeft $ concat rs)
 where
  fromLeft (Left x) = Just x
  fromLeft _ = Nothing

doModule f =
 do c <- readFile f
    let exports  = filter hasUnderscore (grabExports c)
        topLevel = filter hasUnderscore (grabTopLevelFunctions c)
        internal = topLevel \\ exports
    putStrLn $ "Exports: " ++ show exports
    r1s <- mapM globalCamel exports
    putStrLn $ "Internal: " ++ show internal
    r2s <- mapM (localCamel f) internal
    return $ r1s ++ r2s

grabTopLevelFunctions :: String -> [String]
grabTopLevelFunctions = concatMap (wordsBy (`elem` ", ") . takeWhile (/= ':'))
                      . filter ("::" `isInfixOf`)
                      . filter (not . ("--" `isPrefixOf`))
                      . filter (not . all isSpace . take 1)
                      . lines
 where
  trim = takeWhile (not . (`elem` ": "))

grabExports :: String -> [String]
grabExports = takeWhile (/= "where")
            . drop 1
            . dropWhile (/= "module")
            . wordsBy isJunk
 where
  isJunk x = isSpace x || x `elem` ",()."

hasUnderscore [] = False
hasUnderscore [_] = False
hasUnderscore (x:(xs@(_:_))) = any (== '_') (init xs)

globalCamel w =
 do putStrLn $ w ++ " to " ++ w2
    p1 <- system $  unwords [ "find src -name '*hs' | xargs grep -rl", qw2 ]
    case p1 of
      ExitSuccess     -> do putStrLn $ w2 ++ " already exists"
                            return $ Left w
      ExitFailure 123 -> do system $  unwords [ "grep -rl", qw, "src", "|", "xargs darcs replace", qw, qw2 ]
                            return $ Right w2
      ExitFailure x   -> error $ "huh? exit " ++ show x
 where
  qw  = quote w
  qw2 = quote w2
  w2 = camelCase w

localCamel f w =
 do putStrLn $ w ++ " to " ++ w2 ++ " on " ++ f
    ex <- system $  unwords [ "darcs replace", qw, qw2, f ]
    case ex of
      ExitSuccess -> return $ Right w
      _           -> return $ Left w
  where
  qw  = quote w
  qw2 = quote w2
  w2 = camelCase w

quote :: String -> String
quote xs = '"' : xs ++ "\""

camelCase :: String -> String
camelCase [] = []
camelCase (x:xs) = x : helper xs
 where
   helper ('_':c:cs) | isUpper c = '_' : c : helper cs
                     | otherwise = toUpper c : helper cs
   helper (c:cs) = c : helper cs
   helper [] = []