pathtype-0.6: tool/CreateTest.hs

module Main where

import Control.Applicative ((<$>))
import Data.List (stripPrefix, isInfixOf)
import Data.Maybe (mapMaybe)

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        = "<TESTS_GO_HERE>"
testPrefix = "-- >> "

main :: IO ()
main = do
  let mapSndF f (a,b) = (,) a <$> f b
  let readFileNumbered path =
        zipWith (\n row -> ((path,n), row)) [(0::Int)..] . lines <$>
        readFile path
  testLines <-
     mapMaybe (mapSndF $ stripPrefix testPrefix) . 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),t) ->
           printf "  {-# LINE %d \"%s\" #-}\n  (%s,\n      %s) :"
              n src (show t) t) <$> testLines

  writeFile testModule $ unlines $
     ("{- Do not edit! Created from " ++ template ++ " -}") :
     templateHead ++ outLines ++ templateTail