cabal-testsuite/PackageTests/BuildToolPaths/bt/src/Tool.hs

   1 {- HLINT ignore "Use zipWith" -}
   2
   3 module Tool
   4   ( mkTool )
   5   where
   6
   7 -- base
   8 import Control.Monad
   9   ( unless )
  10 import Data.Char
  11   ( isSpace )
  12 import Data.List
  13   ( dropWhileEnd )
  14 import System.Environment
  15   ( getArgs )
  16
  17 -- containers
  18 import Data.Map.Strict
  19   ( Map )
  20 import qualified Data.Map.Strict as Map
  21
  22 -- directory
  23 import System.Directory
  24   ( doesFileExist )
  25
  26 --------------------------------------------------------------------------------
  27
  28 mkTool :: String -> FilePath -> IO ()
  29 mkTool buildToolName customDataFile = do
  30   putStrLn $ "Starting " ++ buildToolName
  31   -- Get all the constants defined in the data file for the build tool.
  32   customDataFileExists <- doesFileExist customDataFile
  33   unless customDataFileExists $ do
  34     error $
  35       unlines
  36         [ "Custom preprocessor " ++ buildToolName ++ " could not access its data file."
  37         , "This is probably due to a missing _datadir environment variable when invoking the build tool."
  38         , "Tried to look in: " ++ customDataFile ]
  39   customDataLines <- lines <$> readFile customDataFile
  40   let customConstants :: Map String Int
  41       customConstants = Map.fromList $ map read customDataLines
  42
  43   -- Obtain input/output file paths from arguments to the preprocessor.
  44   args <- getArgs
  45   case args of
  46     [inputFile, outputFile] -> do
  47       inputFileExists <- doesFileExist inputFile
  48       unless inputFileExists $
  49         error $
  50           unlines
  51             [ "Custom preprocessor " ++ buildToolName ++ " could not read input file."
  52             , "Input file: " ++ inputFile ]
  53       -- Read the input file, substitute constants for their values,
  54       -- and write the result to the output file path.
  55       inputLines <- lines <$> readFile inputFile
  56       let outputLines = map ( preprocessLine customConstants ) ( zip [1..] inputLines )
  57       writeFile outputFile ( unlines outputLines )
  58     [] ->
  59       putStrLn $ "Custom preprocessor " ++ buildToolName ++ ": no arguments."
  60     _ ->
  61       error $
  62         unlines
  63           [ "Custom preprocessor " ++ buildToolName ++ " was given incorrect arguments."
  64           , "Expected input and output file paths, but got " ++ what ++ "." ]
  65       where
  66         what = case args of
  67           [_] -> "a single argument"
  68           _  -> show (length args) ++ " arguments"
  69
  70 -- | Substitute any occurrence of {# ConstantName #} with the value of ConstantName,
  71 -- looked up in the data file for the preprocessor.
  72 preprocessLine :: Map String Int -> ( Int, String ) -> String
  73 preprocessLine constants ( ln_no, ln ) = go "" ln
  74   where
  75     go reversedPrev [] = reverse reversedPrev
  76     go reversedPrev ('{':'#':rest) = reverse reversedPrev ++ inner "" rest
  77     go reversedPrev (c:rest) = go (c:reversedPrev) rest
  78
  79     inner reversedNm ('#':'}':rest) =
  80       let constName = trimWhitespace $ reverse reversedNm
  81        in case Map.lookup constName constants of
  82             Just val -> show val ++ go "" rest
  83             Nothing ->
  84               error $ unlines
  85                 [ "Could not preprocess line " ++ show ln_no ++ ":"
  86                 , "unknown constant \"" ++ constName ++ "\"." ]
  87     inner reversedNm (c:rest) = inner (c:reversedNm) rest
  88     inner reversedNm "" =
  89       error $ unlines
  90         [ "Could not preprocess line " ++ show ln_no ++ ":"
  91         , "unterminated constant \"{# " ++ reverse reversedNm ++ "\"." ]
  92
  93 trimWhitespace :: String -> String
  94 trimWhitespace = dropWhile isSpace . dropWhileEnd isSpace