{- FOURMOLU_DISABLE -}
-- The MIT License (MIT)

-- Copyright (c) 2016-2024 Objectionary.com

-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:

-- The above copyright notice and this permission notice shall be included
-- in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.
{- FOURMOLU_ENABLE -}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module Language.EO.Phi.Pipeline.EOTests.PrepareTests where

import Control.Monad
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Maybe (fromMaybe)
import Data.Yaml (encodeFile)
import Language.EO.Phi.Pipeline.Config
import Language.EO.Phi.Pipeline.EOTests.Data
import System.Directory
import System.FilePath.Posix

prepareTests :: PipelineConfig -> IO ()
prepareTests :: PipelineConfig -> IO ()
prepareTests PipelineConfig
config = do
  [TestSet] -> (TestSet -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((TestSet -> Bool) -> [TestSet] -> [TestSet]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> (TestSet -> Maybe Bool) -> TestSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.enable)) PipelineConfig
config.testSets) ((TestSet -> IO ()) -> IO ()) -> (TestSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \((.eo) -> TestSetEO
testSet) -> do
    test :: Test
test@Test{[Char]
source :: [Char]
$sel:source:Test :: Test -> [Char]
source, [Char]
meta :: [Char]
$sel:meta:Test :: Test -> [Char]
meta} <- [Char] -> IO Test
parseTest TestSetEO
testSet.original
    let exclude :: [[Char]]
exclude = [[Char]] -> Maybe [[Char]] -> [[Char]]
forall a. a -> Maybe a -> a
fromMaybe [] TestSetEO
testSet.exclude
        include :: [[Char]]
include = [[Char]] -> Maybe [[Char]] -> [[Char]]
forall a. a -> Maybe a -> a
fromMaybe (Test
test.programs [Program] -> (Program -> [Char]) -> [[Char]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.name)) TestSetEO
testSet.include [[Char]] -> ([[Char]] -> [[Char]]) -> [[Char]]
forall a b. a -> (a -> b) -> b
& ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
exclude)
        programs :: [Program]
programs = (Program -> Bool) -> [Program] -> [Program]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Program
x -> Program
x.name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
include) Test
test.programs
        testContent :: TestContent
testContent = TestContent{[Char]
[Program]
source :: [Char]
meta :: [Char]
programs :: [Program]
$sel:source:TestContent :: [Char]
$sel:meta:TestContent :: [Char]
$sel:programs:TestContent :: [Program]
..}

    -- write yaml
    let target :: [Char]
target = TestSetEO
testSet.yaml
        targetTmp :: [Char]
targetTmp = [Char]
target [Char] -> [Char] -> [Char]
<.> [Char]
".tmp"
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char] -> [Char]
takeDirectory [Char]
target)
    [Char] -> TestContent -> IO ()
forall a. ToJSON a => [Char] -> a -> IO ()
encodeFile [Char]
targetTmp TestContent
testContent
    [Char] -> IO [Char]
readFile [Char]
targetTmp IO [Char] -> ([Char] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> [Char] -> IO ()
appendFile [Char]
target
    [Char] -> IO ()
removeFile [Char]
targetTmp

    -- write eo
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char] -> [Char]
takeDirectory TestSetEO
testSet.filtered)
    [Char] -> [Char] -> IO ()
writeFile TestSetEO
testSet.filtered [Char]
meta
    [Program] -> (Program -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Program]
programs (\Program
x -> [Char] -> [Char] -> IO ()
appendFile TestSetEO
testSet.filtered Program
x.text)

parseProgramsRaw :: ([(Int, [String])], (Int, [[Char]]), Int) -> [[Char]] -> [(Int, String)]
parseProgramsRaw :: ([(Int, [[Char]])], (Int, [[Char]]), Int)
-> [[Char]] -> [(Int, [Char])]
parseProgramsRaw ([(Int, [[Char]])]
programs', (Int
programStart, [[Char]]
program), Int
curLine) (line' :: [Char]
line'@(Char
x : [Char]
_) : [[Char]]
xs)
  | ([[Char]]
program [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
program [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" Bool -> Bool -> Bool
|| [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
program) Bool -> Bool -> Bool
&& (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') = ([(Int, [[Char]])], (Int, [[Char]]), Int)
-> [[Char]] -> [(Int, [Char])]
parseProgramsRaw ((Int
programStart, [[Char]]
program) (Int, [[Char]]) -> [(Int, [[Char]])] -> [(Int, [[Char]])]
forall a. a -> [a] -> [a]
: [(Int, [[Char]])]
programs', (Int
curLine, [[Char]
line']), Int
curLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [[Char]]
xs
  | Bool
otherwise = ([(Int, [[Char]])], (Int, [[Char]]), Int)
-> [[Char]] -> [(Int, [Char])]
parseProgramsRaw ([(Int, [[Char]])]
programs', (Int
programStart, [Char]
line' [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
program), Int
curLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [[Char]]
xs
parseProgramsRaw ([(Int, [[Char]])]
programs', (Int
programStart, [[Char]]
program), Int
curLine) ([Char]
"" : [[Char]]
xs) = ([(Int, [[Char]])], (Int, [[Char]]), Int)
-> [[Char]] -> [(Int, [Char])]
parseProgramsRaw ([(Int, [[Char]])]
programs', (Int
programStart, [Char]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
program), Int
curLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [[Char]]
xs
parseProgramsRaw ([(Int, [[Char]])]
programs', (Int, [[Char]])
program, Int
_) [] = ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> (Int, [[Char]]) -> (Int, [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Int, [[Char]]) -> (Int, [Char]))
-> [(Int, [[Char]])] -> [(Int, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [(Int, [[Char]])] -> [(Int, [[Char]])]
forall a. Int -> [a] -> [a]
drop Int
1 ([(Int, [[Char]])] -> [(Int, [[Char]])]
forall a. [a] -> [a]
reverse (([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> (Int, [[Char]]) -> (Int, [[Char]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Int, [[Char]]) -> (Int, [[Char]]))
-> [(Int, [[Char]])] -> [(Int, [[Char]])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, [[Char]])
program (Int, [[Char]]) -> [(Int, [[Char]])] -> [(Int, [[Char]])]
forall a. a -> [a] -> [a]
: [(Int, [[Char]])]
programs')))

parseTest' :: FilePath -> [String] -> Test
parseTest' :: [Char] -> [[Char]] -> Test
parseTest' [Char]
source [[Char]]
eoCode =
  let
    ([[Char]]
license, [[Char]]
k') = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\case Char
'#' : [Char]
_ -> Bool
True; [Char]
"" -> Bool
True; [Char]
_ -> Bool
False) [[Char]]
eoCode
    ([[Char]]
meta, [[Char]]
k'') = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\case Char
'+' : [Char]
_ -> Bool
True; [Char]
"" -> Bool
True; [Char]
_ -> Bool
False) [[Char]]
k'
    programsStart :: Int
programsStart = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
license Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
meta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    programsRaw :: [(Int, [Char])]
programsRaw = ([(Int, [[Char]])], (Int, [[Char]]), Int)
-> [[Char]] -> [(Int, [Char])]
parseProgramsRaw ([], (Int
programsStart, []), Int
programsStart) [[Char]]
k''
    programs :: [Program]
programs = [(Int, [Char])]
programsRaw [(Int, [Char])] -> ((Int, [Char]) -> Program) -> [Program]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Int
line, [Char]
text) -> Program{$sel:source:Program :: Pos
source = Pos{$sel:file:Pos :: [Char]
file = [Char]
source, Int
line :: Int
$sel:line:Pos :: Int
..}, $sel:name:Program :: [Char]
name = [Char]
text [Char] -> ([Char] -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[') [Char] -> ([Char] -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
5 [Char] -> ([Char] -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'), [Char]
text :: [Char]
$sel:text:Program :: [Char]
..})
   in
    Test{$sel:license:Test :: [Char]
license = [[Char]] -> [Char]
unlines [[Char]]
license, $sel:meta:Test :: [Char]
meta = [[Char]] -> [Char]
unlines [[Char]]
meta, [Char]
[Program]
$sel:source:Test :: [Char]
source :: [Char]
programs :: [Program]
$sel:programs:Test :: [Program]
..}

parseTest :: FilePath -> IO Test
parseTest :: [Char] -> IO Test
parseTest [Char]
path = [Char] -> IO [Char]
readFile [Char]
path IO [Char] -> ([Char] -> Test) -> IO Test
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Char] -> [[Char]] -> Test
parseTest' [Char]
path ([[Char]] -> Test) -> ([Char] -> [[Char]]) -> [Char] -> Test
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines)