{- 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 DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

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

import Control.Monad (guard)
import Data.String (IsString (..))
import Data.Text qualified as T
import Data.Yaml.Aeson
import GHC.Generics (Generic)
import Language.EO.Phi.TH (deriveJSON)
import Text.Read (readMaybe)

data Pos = Pos
  { Pos -> FilePath
file :: FilePath
  , Pos -> Int
line :: Int
  }
  deriving stock (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> FilePath
(Int -> Pos -> ShowS)
-> (Pos -> FilePath) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pos -> ShowS
showsPrec :: Int -> Pos -> ShowS
$cshow :: Pos -> FilePath
show :: Pos -> FilePath
$cshowList :: [Pos] -> ShowS
showList :: [Pos] -> ShowS
Show)

instance ToJSON Pos where
  toJSON :: Pos -> Value
  toJSON :: Pos -> Value
toJSON Pos{Int
FilePath
$sel:file:Pos :: Pos -> FilePath
$sel:line:Pos :: Pos -> Int
file :: FilePath
line :: Int
..} = Text -> Value
String (FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (FilePath
file FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
":" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line))

instance FromJSON Pos where
  parseJSON :: Value -> Parser Pos
  parseJSON :: Value -> Parser Pos
parseJSON = FilePath -> (Text -> Parser Pos) -> Value -> Parser Pos
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
withText FilePath
"Pos" ((Text -> Parser Pos) -> Value -> Parser Pos)
-> (Text -> Parser Pos) -> Value -> Parser Pos
forall a b. (a -> b) -> a -> b
$ \(Text -> FilePath
T.unpack -> FilePath
x) -> do
    let (FilePath
file, FilePath
rs) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') FilePath
x
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
file)
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
    let line' :: Maybe Int
line' = FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
rs)
    Parser Pos -> (Int -> Parser Pos) -> Maybe Int -> Parser Pos
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Parser Pos
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser Pos) -> FilePath -> Parser Pos
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not a number") (\Int
line -> Pos -> Parser Pos
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pos{Int
FilePath
$sel:file:Pos :: FilePath
$sel:line:Pos :: Int
file :: FilePath
line :: Int
..}) Maybe Int
line'

data Program = Program
  { Program -> Pos
source :: Pos
  , Program -> FilePath
name :: String
  , Program -> FilePath
text :: String
  }
  deriving stock (Int -> Program -> ShowS
[Program] -> ShowS
Program -> FilePath
(Int -> Program -> ShowS)
-> (Program -> FilePath) -> ([Program] -> ShowS) -> Show Program
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Program -> ShowS
showsPrec :: Int -> Program -> ShowS
$cshow :: Program -> FilePath
show :: Program -> FilePath
$cshowList :: [Program] -> ShowS
showList :: [Program] -> ShowS
Show, (forall x. Program -> Rep Program x)
-> (forall x. Rep Program x -> Program) -> Generic Program
forall x. Rep Program x -> Program
forall x. Program -> Rep Program x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Program -> Rep Program x
from :: forall x. Program -> Rep Program x
$cto :: forall x. Rep Program x -> Program
to :: forall x. Rep Program x -> Program
Generic)

$(deriveJSON ''Program)

data Test = Test
  { Test -> FilePath
source :: String
  , Test -> FilePath
license :: String
  , Test -> FilePath
meta :: String
  , Test -> [Program]
programs :: [Program]
  }
  deriving stock (Int -> Test -> ShowS
[Test] -> ShowS
Test -> FilePath
(Int -> Test -> ShowS)
-> (Test -> FilePath) -> ([Test] -> ShowS) -> Show Test
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Test -> ShowS
showsPrec :: Int -> Test -> ShowS
$cshow :: Test -> FilePath
show :: Test -> FilePath
$cshowList :: [Test] -> ShowS
showList :: [Test] -> ShowS
Show, (forall x. Test -> Rep Test x)
-> (forall x. Rep Test x -> Test) -> Generic Test
forall x. Rep Test x -> Test
forall x. Test -> Rep Test x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Test -> Rep Test x
from :: forall x. Test -> Rep Test x
$cto :: forall x. Rep Test x -> Test
to :: forall x. Rep Test x -> Test
Generic)

$(deriveJSON ''Test)

data TestContent = TestContent
  { TestContent -> FilePath
source :: FilePath
  , TestContent -> FilePath
meta :: String
  , TestContent -> [Program]
programs :: [Program]
  }
  deriving stock (Int -> TestContent -> ShowS
[TestContent] -> ShowS
TestContent -> FilePath
(Int -> TestContent -> ShowS)
-> (TestContent -> FilePath)
-> ([TestContent] -> ShowS)
-> Show TestContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestContent -> ShowS
showsPrec :: Int -> TestContent -> ShowS
$cshow :: TestContent -> FilePath
show :: TestContent -> FilePath
$cshowList :: [TestContent] -> ShowS
showList :: [TestContent] -> ShowS
Show, (forall x. TestContent -> Rep TestContent x)
-> (forall x. Rep TestContent x -> TestContent)
-> Generic TestContent
forall x. Rep TestContent x -> TestContent
forall x. TestContent -> Rep TestContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestContent -> Rep TestContent x
from :: forall x. TestContent -> Rep TestContent x
$cto :: forall x. Rep TestContent x -> TestContent
to :: forall x. Rep TestContent x -> TestContent
Generic)

$(deriveJSON ''TestContent)