import Lexer
import Layout
import System
import List
import IO
import Unlit


trans fname xs = f 0 xs where
    f n rs@(L (AlexPn _ l cp) _ _:_) | n /= l = (if l == n + 1 then (Token "\n":) else (Token ("{-# LINE " ++ show l ++ " " ++ show fname ++ " #-}"):)) $ TokenNL cp:f l rs
    f n (L _ c s:rs@(L _ _ "{":_)) | s `elem` layoutStarters = Token s:f n rs
    f n (L _ c s:rs@(L (AlexPn _ _ cp) _ _:_)) | s `elem` layoutStarters = Token s:TokenVLCurly s cp:f n rs
    f n (L _ c s:rs) = Token s:f n rs
    f _ [] = []

layoutStarters = ["where","let","of","do"]

showT (TokenVLCurly _ n) = "{" ++ show n
showT (TokenNL n) = "\n(" ++ show n ++ ")"
showT (Token ('{':'-':s)) = '\n':'{':'-':s ++ "\n"
showT (Token s) = s

readHsFile rfn fn
    | "shl." `isPrefixOf` reverse fn = unlit rfn `fmap` readFile fn
    | otherwise = readFile fn

main = do
    as <- getArgs
    case as of
        [ofilename,infile,outfile] -> do
            hPutStrLn stderr $ "getlaid " ++ ofilename ++ ": " ++ infile ++ " -> " ++ outfile
            s <- readHsFile ofilename infile
            if "-- dontlay" `isPrefixOf` s then writeFile outfile s else writeFile outfile (f ofilename s)
        [infile] -> do
            s <- readHsFile infile infile
            putStr (f infile s)
        _ -> do
            s <- getContents
            putStr (f "(unknown)" s)

f fname s = let ts = case scanner s of
                    Right ss@(L _ LReservedId "module":_) -> trans fname ss
                    Right ss@(L (AlexPn _ _ cp) _ _:_) -> mainHeader ++ TokenVLCurly "where" cp:trans fname ss
                    Left s -> error $ "error parsing file: " ++ show s
                    x -> error (show x)
            in (unwords $ map showT (layout ts [])) ++ "\n"


mainHeader = [TokenNL 1,Token "module",Token "Main",Token "(",Token "main",Token ")",Token "where"]