module Main where import qualified Control.Functor.HT as FuncHT import Control.Applicative ((<$>), (<$)) import Data.List (stripPrefix, isInfixOf) import Data.Maybe (mapMaybe) import Data.Tuple.HT (mapFst) import Data.Char (isSpace) import Text.Printf (printf) srcfiles :: [String] template, testModule, tok, testPrefix :: String srcfiles = map ("src/System/Path/" ++) $ ["Internal.hs", "Directory.hs", "IO.hs"] template = "test/TestTemplate.hs" testModule = "test/TestResult.hs" tok = "" testPrefix = "-- >> " main :: IO () main = do let readFileNumbered path = zip ((,) path <$> [(0::Int)..]) . lines <$> readFile path testLines <- mapMaybe (FuncHT.mapSnd $ stripPrefix testPrefix) . map (\(n,row) -> mapFst ((,) n) $ span isSpace row) . concat <$> mapM readFileNumbered srcfiles (templateHead,_:templateTail) <- break (tok `isInfixOf`) . lines <$> readFile template {- Choose the same indentation depth as in the source file, such that GHC reports precise source file locations. -} let outLines = (\(((src,n),ind),t) -> printf " {-# LINE %d \"%s\" #-}\n (%s,\n%s%s%s) :" n src (show t) ind (' ' <$ testPrefix) t) <$> testLines writeFile testModule $ unlines $ ("{- Do not edit! Created from " ++ template ++ " -}") : templateHead ++ outLines ++ templateTail