{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Coolbal.MakeParse (
    parseGHCmake,
) where

import Data.Char (isSpace)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import System.FilePath ((</>), makeRelative, takeExtension, dropExtension)


-- | Parse output of @ghc -M@ to give a module dependency graph.
-- @projdir@ should be the canonical path of the project root directory;
-- @builddir@ should be a relative path from @projdir@ to the build directory.
parseGHCmake :: FilePath -> FilePath -> String -> Either String (Map [String] [[String]])
parseGHCmake projdir builddir output = do
    rules <- sequence (catMaybes (map (parseRule projdir builddir) (lines output)))
    return (Map.fromListWith (++) (map (\case Node k -> (k, []) ; Rule k v -> (k, [v])) rules))

data Rule = Node [String] | Rule [String] [String]
  deriving (Show)

parseRule :: FilePath -> FilePath -> String -> Maybe (Either String Rule)
parseRule _ _ ('#' : _) = Nothing
parseRule projdir builddir line =
    case splitOn1 ':' line of
      Just (lhs, rhs) ->
          let lhs' = dropWhile (== '/') (makeRelative (projdir </> builddir) (strip lhs))
              rhs' = makeRelative builddir (strip rhs)
          in case takeExtension rhs' of
               ".hi" -> Just (Right (Rule (toModule lhs') (toModule rhs')))
               ".hs" -> Just (Right (Node (toModule lhs')))
               _ -> errmsg
      _ -> errmsg
  where
    errmsg = Just (Left ("Cannot parse -M line: " ++ show line))
    toModule = splitOn '/' . dropExtension

strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse

splitOn1 :: Eq a => a -> [a] -> Maybe ([a], [a])
splitOn1 x xs = case span (/= x) xs of
                  (pre, _ : post) -> Just (pre, post)
                  _ -> Nothing

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn x xs = case span (/= x) xs of
                 (pre, _ : post) -> pre : splitOn x post
                 (pre, []) -> [pre]