FixImports.hs

{-# LANGUAGE NamedFieldPuns #-}
module FixImports where

import Data.Functor (void)
import Data.List (span, isPrefixOf, intercalate)
import qualified Text.Parsec as P
import qualified
  Text.Parsec.String as P
import Data.Char as DC (isSpace)
import Debug.Trace as
 Trace

type Lines = [String]

overImports :: ([Import] -> [Import]) -> Lines -> Lines
overImports f =
  overImportLines $ \ls ->
    case P.parse (P.many p_import <* P.eof) "" (unlines ls) of
      Left err -> error $ "Failed to parse imports:\n" ++ unlines ls ++ "\n\n" ++ show err
      Right x -> map ppImport (f x)

overImportLines :: (Lines -> Lines) -> Lines -> Lines
overImportLines f lines =
  let (header, imports, footer) = splitImports lines
  in header ++ f imports ++ footer

splitImports :: Lines -> (Lines, Lines, Lines)
splitImports lines =
  let
    (header, lines1) = span (not . isImportStart) lines
    (imports, footer) = span (\l -> isImportStart l || isContinuation l) lines1
  in (header, imports, footer)

isImportStart :: String -> Bool
isImportStart s = "import " `isPrefixOf` s

isContinuation :: String -> Bool
isContinuation s = " " `isPrefixOf` s

data Import = Import
  { moduleName :: String
  , qualified :: Bool
  , identifiers :: Maybe [String]
  , alias :: Maybe String
  } deriving (Eq, Show)

p_import :: P.Parser Import
p_import = do
  keyword "import"

  qualified <- (True <$ keyword "qualified") P.<|> pure False

  moduleName <- identifier

  alias <- P.optionMaybe $ keyword "as" *> identifier

  identifiers <- P.optionMaybe $
    P.char '(' *> whitespace *>
    (identifier `P.sepBy` comma)
    <* P.char ')' <* whitespace

--  trace ("modName: " ++ moduleName ++ " qualified: " ++ show qualified ++ " identifiers: " ++ show identifiers ++ " alias: " ++ show alias) $ do

  pure Import { moduleName, qualified, identifiers, alias }

comma = P.char ',' *> whitespace

keyword :: String -> P.Parser ()
keyword str = do
  P.string str
  P.notFollowedBy identifierChar
  whitespace

identifier :: P.Parser String
identifier = do
  value <- P.many1 identifierChar
  whitespace
  pure value

identifierChar = P.satisfy (\c -> not (isSpace c) && c `notElem` ['(', ',', ')'])

whitespace1 :: P.Parser ()
whitespace1 = void $ P.many1 (P.satisfy isSpace)

whitespace :: P.Parser ()
whitespace = void $ P.many (P.satisfy isSpace)

ppImport :: Import -> String
ppImport i = concat $
  [ "import " ] ++ 
  [ "qualified " | qualified i ] ++
  [ moduleName i , " "
  , maybe "" ppAlias ( alias i)
  , maybe "" ppImportList (identifiers i)
  ]

  where
    ppImportList xs = "(" ++ intercalate ", " xs ++ ")"
    ppAlias a = "as " ++ a