Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
74 lines (62 sloc) 2.58 KB
module Main (
main
) where
import Data.Generics ( mkT, everywhere )
import Data.List ( isPrefixOf, tails )
import Language.Haskell.Exts ( prettyPrint
, ParseResult(..), parseFileWithExts
, Module(..), Exp(..), QOp(..)
, QName(..), Name(..), Literal(..)
, ImportDecl(..), ModuleName(..), SrcLoc(..) )
import System.Environment ( getArgs )
import Text.Printf ( printf )
import Text.Regex.Posix ( (=~) )
main :: IO ()
main = do
[_, fin, fout] <- getArgs
res <- parseFileWithExts [] fin
case res of
ParseFailed loc reason -> do
printf "%s:%s: Parse Failed: %s" fin (show loc) reason
writeFile fout =<< readFile fin
ParseOk m -> do
let magicLine = "{-# LINE 1 \"" ++ fin ++ "\" #-}\n"
writeFile fout $ magicLine ++ prettyPrint (transform m)
transform :: Module -> Module
transform = addNecessaryDecls . everywhere (mkT trans)
where
addNecessaryDecls m
| strstr "^-^" (prettyPrint m) = addDecl m
| otherwise = m
strstr w = any id . map (isPrefixOf w) . tails
addDecl :: Module -> Module
addDecl (Module sl mn mps mwt mes ids ds) =
let ids' = (ImportDecl{ importLoc = SrcLoc { srcFilename = ""
, srcLine = 0
, srcColumn = 0 }
, importModule = ModuleName "Text.Interpol"
, importQualified = False
, importSrc = False
, importPkg = Nothing
, importAs = Nothing
, importSpecs = Nothing }) : ids
in Module sl mn mps mwt mes ids' ds
trans :: Exp -> Exp
trans (Lit (String s)) = interpol s
trans e = e
identRE = "\\{[A-z_][A-z0-9_]*}"
interpol :: String -> Exp
interpol s
| s =~ identRE = Paren $ go s
| otherwise = Lit (String s)
go :: String -> Exp
go s = let (before, ident, after) = s =~ identRE
e = InfixApp (Lit (String before))
appendOp
(Var (UnQual (Ident $ ti ident)))
in case ident of
"" -> (Lit (String before))
_ -> InfixApp e appendOp $ go after
appendOp :: QOp
appendOp = QVarOp (UnQual (Symbol "^-^"))
ti = tail . init
Jump to Line
Something went wrong with that request. Please try again.