{-# 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