TestFile.hs

{-# LANGUAGE OverloadedStrings #-}

module Core.Test.Descript.TestFile
  ( TestFile (..)
  , TestInfo (..)
  , RefactorInfo (..)
  , loadFilesInDir
  ) where

import Descript.Misc
import System.Directory
import System.FilePath
import Data.Maybe
import Data.List
import Data.Text (Text)
import Data.Yaml
import Control.Applicative

data TestFile
  = TestFile
  { srcFile :: SFile
  , testInfo :: TestInfo
  } deriving (Eq, Ord, Read, Show)

data TestInfo
  = TestInfo
  { printParsedPhases :: [String]
  , printDependency :: Bool
  , printEvaluated :: Bool
  , printCompiled :: Bool
  , printReprinted :: Bool
  , isParseable :: Bool
  , isValid :: Bool
  , isTerminating :: Bool
  , isFinal :: Bool
  , evalPr :: Text
  , packagePr :: Text
  , refactorCmds :: [RefactorInfo]
  , errorMsg :: String
  , problemMsgs :: [String]
  } deriving (Eq, Ord, Read, Show)

data RefactorInfo
  = RefactorInfo
  { refactorCmdAction :: String
  , refactorCmdArgs :: [String]
  , refactorWarningMsgs :: [String]
  , refactorErrorMsg :: String
  , refactorLabel :: String
  } deriving (Eq, Ord, Read, Show)

instance FromJSON TestInfo where
  parseJSON = withObject "TestInfo" $ \x -> TestInfo
    <$> x .:? "printParsedPhases" .!= []
    <*> x .:? "printDependency?" .!= False
    <*> x .:? "printEval?" .!= False
    <*> x .:? "printCompile?" .!= False
    <*> x .:? "printReprint?" .!= False
    <*> x .:? "parses?" .!= True
    <*> x .:? "valid?" .!= True
    <*> x .:? "terminates?" .!= True
    <*> x .:? "final?" .!= True
    <*> x .:? "eval" .!= ""
    <*> x .:? "compile" .!= ""
    <*> x .:? "refactor" .!= []
    <*> x .:? "error" .!= ""
    <*> x .:? "problems" .!= []

instance FromJSON RefactorInfo where
  parseJSON val = parseStr val <|> parseObject val
    where parseStr = fmap mkBasicRefactorInfo . parseJSON
          parseObject = withObject "RefactorInfo" $ \x -> mkRefactorInfo
            <$> x .: "action"
            <*> x .:? "warnings" .!= []
            <*> x .:? "error" .!= ""
            <*> x .:? "label"

-- | Gets the all test files in the directory, assuming the directory doesn't
-- contain any sub-directories.
loadFilesInDir :: FilePath -> IO [TestFile]
loadFilesInDir dir
    = traverse (loadTestFileInDir dir)
    . mapMaybe (stripSuffix ".dscr")
  =<< listDirectory dir

-- | Reads the test file in the given directory with the given name.
loadTestFileInDir :: FilePath -> String -> IO TestFile
loadTestFileInDir dir name'
  = TestFile <$> loadSrcFileInDir dir name' <*> loadTestInfoInDir dir name'

-- | Reads the source file in the given directory with the given name.
loadSrcFileInDir :: FilePath -> String -> IO SFile
loadSrcFileInDir dir name' = loadSFile $ dir </> name' <.> "dscr"

-- | Reads the source file in the given directory with the given name.
loadTestInfoInDir :: FilePath -> String -> IO TestInfo
loadTestInfoInDir dir name' = do
  let path = dir </> name' <.> "out.yaml"
  result <- decodeFileEither path
  case result of
    Left err
      -> fail
       $ "Error while decoding test info for "
      ++ name'
      ++ ": "
      ++ prettyPrintParseException err
    Right x -> pure x

mkBasicRefactorInfo :: String -> RefactorInfo
mkBasicRefactorInfo cmd = mkRefactorInfo cmd [] "" Nothing

mkRefactorInfo :: String -> [String] -> String -> Maybe String -> RefactorInfo
mkRefactorInfo cmd warnMsgs errMsg optLabel
  = case parseCmd cmd of
         [] -> error "refactor command can't be empty, needs action specified"
         action : args -> RefactorInfo action args warnMsgs errMsg label
           where label = action `fromMaybe` optLabel

parseCmd :: String -> [String]
parseCmd cmd
  = case lines cmd of
         [] -> [""]
         [cmd1] -> words cmd1
         parts -> parts

stripSuffix :: (Eq a) => [a] -> [a] -> Maybe [a]
stripSuffix suf = fmap reverse . stripPrefix (reverse suf) . reverse