{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wwarn #-}

module Ide.Plugin.Eval.Types (
    locate,
    locate0,
    Test (..),
    isProperty,
    Format (..),
    Language (..),
    Section (..),
    hasTests,
    hasPropertyTest,
    splitSections,
    Loc,
    Located (..),
    unLoc,
    Txt,
) where

import Control.DeepSeq (NFData (rnf), deepseq)
import Data.Aeson (FromJSON, ToJSON)
import Data.List (partition)
import Data.List.NonEmpty (NonEmpty)
import Data.String (IsString (..))
import GHC.Generics (Generic)

-- | A thing with a location attached.
data Located l a = Located {Located l a -> l
location :: l, Located l a -> a
located :: a}
    deriving (Located l a -> Located l a -> Bool
(Located l a -> Located l a -> Bool)
-> (Located l a -> Located l a -> Bool) -> Eq (Located l a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l a. (Eq l, Eq a) => Located l a -> Located l a -> Bool
/= :: Located l a -> Located l a -> Bool
$c/= :: forall l a. (Eq l, Eq a) => Located l a -> Located l a -> Bool
== :: Located l a -> Located l a -> Bool
$c== :: forall l a. (Eq l, Eq a) => Located l a -> Located l a -> Bool
Eq, Int -> Located l a -> ShowS
[Located l a] -> ShowS
Located l a -> String
(Int -> Located l a -> ShowS)
-> (Located l a -> String)
-> ([Located l a] -> ShowS)
-> Show (Located l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l a. (Show l, Show a) => Int -> Located l a -> ShowS
forall l a. (Show l, Show a) => [Located l a] -> ShowS
forall l a. (Show l, Show a) => Located l a -> String
showList :: [Located l a] -> ShowS
$cshowList :: forall l a. (Show l, Show a) => [Located l a] -> ShowS
show :: Located l a -> String
$cshow :: forall l a. (Show l, Show a) => Located l a -> String
showsPrec :: Int -> Located l a -> ShowS
$cshowsPrec :: forall l a. (Show l, Show a) => Int -> Located l a -> ShowS
Show, Eq (Located l a)
Eq (Located l a)
-> (Located l a -> Located l a -> Ordering)
-> (Located l a -> Located l a -> Bool)
-> (Located l a -> Located l a -> Bool)
-> (Located l a -> Located l a -> Bool)
-> (Located l a -> Located l a -> Bool)
-> (Located l a -> Located l a -> Located l a)
-> (Located l a -> Located l a -> Located l a)
-> Ord (Located l a)
Located l a -> Located l a -> Bool
Located l a -> Located l a -> Ordering
Located l a -> Located l a -> Located l a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall l a. (Ord l, Ord a) => Eq (Located l a)
forall l a. (Ord l, Ord a) => Located l a -> Located l a -> Bool
forall l a.
(Ord l, Ord a) =>
Located l a -> Located l a -> Ordering
forall l a.
(Ord l, Ord a) =>
Located l a -> Located l a -> Located l a
min :: Located l a -> Located l a -> Located l a
$cmin :: forall l a.
(Ord l, Ord a) =>
Located l a -> Located l a -> Located l a
max :: Located l a -> Located l a -> Located l a
$cmax :: forall l a.
(Ord l, Ord a) =>
Located l a -> Located l a -> Located l a
>= :: Located l a -> Located l a -> Bool
$c>= :: forall l a. (Ord l, Ord a) => Located l a -> Located l a -> Bool
> :: Located l a -> Located l a -> Bool
$c> :: forall l a. (Ord l, Ord a) => Located l a -> Located l a -> Bool
<= :: Located l a -> Located l a -> Bool
$c<= :: forall l a. (Ord l, Ord a) => Located l a -> Located l a -> Bool
< :: Located l a -> Located l a -> Bool
$c< :: forall l a. (Ord l, Ord a) => Located l a -> Located l a -> Bool
compare :: Located l a -> Located l a -> Ordering
$ccompare :: forall l a.
(Ord l, Ord a) =>
Located l a -> Located l a -> Ordering
$cp1Ord :: forall l a. (Ord l, Ord a) => Eq (Located l a)
Ord, a -> Located l b -> Located l a
(a -> b) -> Located l a -> Located l b
(forall a b. (a -> b) -> Located l a -> Located l b)
-> (forall a b. a -> Located l b -> Located l a)
-> Functor (Located l)
forall a b. a -> Located l b -> Located l a
forall a b. (a -> b) -> Located l a -> Located l b
forall l a b. a -> Located l b -> Located l a
forall l a b. (a -> b) -> Located l a -> Located l b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Located l b -> Located l a
$c<$ :: forall l a b. a -> Located l b -> Located l a
fmap :: (a -> b) -> Located l a -> Located l b
$cfmap :: forall l a b. (a -> b) -> Located l a -> Located l b
Functor, (forall x. Located l a -> Rep (Located l a) x)
-> (forall x. Rep (Located l a) x -> Located l a)
-> Generic (Located l a)
forall x. Rep (Located l a) x -> Located l a
forall x. Located l a -> Rep (Located l a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l a x. Rep (Located l a) x -> Located l a
forall l a x. Located l a -> Rep (Located l a) x
$cto :: forall l a x. Rep (Located l a) x -> Located l a
$cfrom :: forall l a x. Located l a -> Rep (Located l a) x
Generic, Value -> Parser [Located l a]
Value -> Parser (Located l a)
(Value -> Parser (Located l a))
-> (Value -> Parser [Located l a]) -> FromJSON (Located l a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall l a.
(FromJSON l, FromJSON a) =>
Value -> Parser [Located l a]
forall l a.
(FromJSON l, FromJSON a) =>
Value -> Parser (Located l a)
parseJSONList :: Value -> Parser [Located l a]
$cparseJSONList :: forall l a.
(FromJSON l, FromJSON a) =>
Value -> Parser [Located l a]
parseJSON :: Value -> Parser (Located l a)
$cparseJSON :: forall l a.
(FromJSON l, FromJSON a) =>
Value -> Parser (Located l a)
FromJSON, [Located l a] -> Encoding
[Located l a] -> Value
Located l a -> Encoding
Located l a -> Value
(Located l a -> Value)
-> (Located l a -> Encoding)
-> ([Located l a] -> Value)
-> ([Located l a] -> Encoding)
-> ToJSON (Located l a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall l a. (ToJSON a, ToJSON l) => [Located l a] -> Encoding
forall l a. (ToJSON a, ToJSON l) => [Located l a] -> Value
forall l a. (ToJSON a, ToJSON l) => Located l a -> Encoding
forall l a. (ToJSON a, ToJSON l) => Located l a -> Value
toEncodingList :: [Located l a] -> Encoding
$ctoEncodingList :: forall l a. (ToJSON a, ToJSON l) => [Located l a] -> Encoding
toJSONList :: [Located l a] -> Value
$ctoJSONList :: forall l a. (ToJSON a, ToJSON l) => [Located l a] -> Value
toEncoding :: Located l a -> Encoding
$ctoEncoding :: forall l a. (ToJSON a, ToJSON l) => Located l a -> Encoding
toJSON :: Located l a -> Value
$ctoJSON :: forall l a. (ToJSON a, ToJSON l) => Located l a -> Value
ToJSON)

-- | Discard location information.
unLoc :: Located l a -> a
unLoc :: Located l a -> a
unLoc (Located l
_ a
a) = a
a

instance (NFData l, NFData a) => NFData (Located l a) where
    rnf :: Located l a -> ()
rnf (Located l
loc a
a) = l
loc l -> a -> a
forall a b. NFData a => a -> b -> b
`deepseq` a
a a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()

type Loc = Located Line

type Line = Int

locate :: Loc [a] -> [Loc a]
locate :: Loc [a] -> [Loc a]
locate (Located Int
l [a]
tst) = (Int -> a -> Loc a) -> [Int] -> [a] -> [Loc a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> Loc a
forall l a. l -> a -> Located l a
Located [Int
l ..] [a]
tst

locate0 :: [a] -> [Loc a]
locate0 :: [a] -> [Loc a]
locate0 = Loc [a] -> [Loc a]
forall a. Loc [a] -> [Loc a]
locate (Loc [a] -> [Loc a]) -> ([a] -> Loc [a]) -> [a] -> [Loc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> Loc [a]
forall l a. l -> a -> Located l a
Located Int
0

type Txt = String

data Section = Section
    { Section -> String
sectionName :: Txt
    , Section -> [Loc Test]
sectionTests :: [Loc Test]
    , Section -> Language
sectionLanguage :: Language
    , Section -> Format
sectionFormat :: Format
    }
    deriving (Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show, (forall x. Section -> Rep Section x)
-> (forall x. Rep Section x -> Section) -> Generic Section
forall x. Rep Section x -> Section
forall x. Section -> Rep Section x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Section x -> Section
$cfrom :: forall x. Section -> Rep Section x
Generic, Value -> Parser [Section]
Value -> Parser Section
(Value -> Parser Section)
-> (Value -> Parser [Section]) -> FromJSON Section
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Section]
$cparseJSONList :: Value -> Parser [Section]
parseJSON :: Value -> Parser Section
$cparseJSON :: Value -> Parser Section
FromJSON, [Section] -> Encoding
[Section] -> Value
Section -> Encoding
Section -> Value
(Section -> Value)
-> (Section -> Encoding)
-> ([Section] -> Value)
-> ([Section] -> Encoding)
-> ToJSON Section
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Section] -> Encoding
$ctoEncodingList :: [Section] -> Encoding
toJSONList :: [Section] -> Value
$ctoJSONList :: [Section] -> Value
toEncoding :: Section -> Encoding
$ctoEncoding :: Section -> Encoding
toJSON :: Section -> Value
$ctoJSON :: Section -> Value
ToJSON, Section -> ()
(Section -> ()) -> NFData Section
forall a. (a -> ()) -> NFData a
rnf :: Section -> ()
$crnf :: Section -> ()
NFData)

hasTests :: Section -> Bool
hasTests :: Section -> Bool
hasTests = Bool -> Bool
not (Bool -> Bool) -> (Section -> Bool) -> Section -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc Test] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Loc Test] -> Bool) -> (Section -> [Loc Test]) -> Section -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> [Loc Test]
sectionTests

hasPropertyTest :: Section -> Bool
hasPropertyTest :: Section -> Bool
hasPropertyTest = (Loc Test -> Bool) -> [Loc Test] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Test -> Bool
isProperty (Test -> Bool) -> (Loc Test -> Test) -> Loc Test -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc Test -> Test
forall l a. Located l a -> a
unLoc) ([Loc Test] -> Bool) -> (Section -> [Loc Test]) -> Section -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> [Loc Test]
sectionTests

-- |Split setup and normal sections
splitSections :: [Section] -> ([Section], [Section])
splitSections :: [Section] -> ([Section], [Section])
splitSections = (Section -> Bool) -> [Section] -> ([Section], [Section])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"setup") (String -> Bool) -> (Section -> String) -> Section -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> String
sectionName)

data Test
    = Example {Test -> NonEmpty String
testLines :: NonEmpty Txt, Test -> [String]
testOutput :: [Txt]}
    | Property {Test -> String
testline :: Txt, testOutput :: [Txt]}
    deriving (Test -> Test -> Bool
(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Test -> Test -> Bool
$c/= :: Test -> Test -> Bool
== :: Test -> Test -> Bool
$c== :: Test -> Test -> Bool
Eq, Int -> Test -> ShowS
[Test] -> ShowS
Test -> String
(Int -> Test -> ShowS)
-> (Test -> String) -> ([Test] -> ShowS) -> Show Test
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Test] -> ShowS
$cshowList :: [Test] -> ShowS
show :: Test -> String
$cshow :: Test -> String
showsPrec :: Int -> Test -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Test x -> Test
$cfrom :: forall x. Test -> Rep Test x
Generic, Value -> Parser [Test]
Value -> Parser Test
(Value -> Parser Test) -> (Value -> Parser [Test]) -> FromJSON Test
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Test]
$cparseJSONList :: Value -> Parser [Test]
parseJSON :: Value -> Parser Test
$cparseJSON :: Value -> Parser Test
FromJSON, [Test] -> Encoding
[Test] -> Value
Test -> Encoding
Test -> Value
(Test -> Value)
-> (Test -> Encoding)
-> ([Test] -> Value)
-> ([Test] -> Encoding)
-> ToJSON Test
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Test] -> Encoding
$ctoEncodingList :: [Test] -> Encoding
toJSONList :: [Test] -> Value
$ctoJSONList :: [Test] -> Value
toEncoding :: Test -> Encoding
$ctoEncoding :: Test -> Encoding
toJSON :: Test -> Value
$ctoJSON :: Test -> Value
ToJSON, Test -> ()
(Test -> ()) -> NFData Test
forall a. (a -> ()) -> NFData a
rnf :: Test -> ()
$crnf :: Test -> ()
NFData)

isProperty :: Test -> Bool
isProperty :: Test -> Bool
isProperty (Property String
_ [String]
_) = Bool
True
isProperty Test
_ = Bool
False

data Format = SingleLine | MultiLine deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Eq Format
Eq Format
-> (Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c< :: Format -> Format -> Bool
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
$cp1Ord :: Eq Format
Ord, (forall x. Format -> Rep Format x)
-> (forall x. Rep Format x -> Format) -> Generic Format
forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Format x -> Format
$cfrom :: forall x. Format -> Rep Format x
Generic, Value -> Parser [Format]
Value -> Parser Format
(Value -> Parser Format)
-> (Value -> Parser [Format]) -> FromJSON Format
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Format]
$cparseJSONList :: Value -> Parser [Format]
parseJSON :: Value -> Parser Format
$cparseJSON :: Value -> Parser Format
FromJSON, [Format] -> Encoding
[Format] -> Value
Format -> Encoding
Format -> Value
(Format -> Value)
-> (Format -> Encoding)
-> ([Format] -> Value)
-> ([Format] -> Encoding)
-> ToJSON Format
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Format] -> Encoding
$ctoEncodingList :: [Format] -> Encoding
toJSONList :: [Format] -> Value
$ctoJSONList :: [Format] -> Value
toEncoding :: Format -> Encoding
$ctoEncoding :: Format -> Encoding
toJSON :: Format -> Value
$ctoJSON :: Format -> Value
ToJSON, Format -> ()
(Format -> ()) -> NFData Format
forall a. (a -> ()) -> NFData a
rnf :: Format -> ()
$crnf :: Format -> ()
NFData)

data Language = Plain | Haddock deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic, Eq Language
Eq Language
-> (Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
$cp1Ord :: Eq Language
Ord, Value -> Parser [Language]
Value -> Parser Language
(Value -> Parser Language)
-> (Value -> Parser [Language]) -> FromJSON Language
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Language]
$cparseJSONList :: Value -> Parser [Language]
parseJSON :: Value -> Parser Language
$cparseJSON :: Value -> Parser Language
FromJSON, [Language] -> Encoding
[Language] -> Value
Language -> Encoding
Language -> Value
(Language -> Value)
-> (Language -> Encoding)
-> ([Language] -> Value)
-> ([Language] -> Encoding)
-> ToJSON Language
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Language] -> Encoding
$ctoEncodingList :: [Language] -> Encoding
toJSONList :: [Language] -> Value
$ctoJSONList :: [Language] -> Value
toEncoding :: Language -> Encoding
$ctoEncoding :: Language -> Encoding
toJSON :: Language -> Value
$ctoJSON :: Language -> Value
ToJSON, Language -> ()
(Language -> ()) -> NFData Language
forall a. (a -> ()) -> NFData a
rnf :: Language -> ()
$crnf :: Language -> ()
NFData)

data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine
    deriving (ExpectedLine -> ExpectedLine -> Bool
(ExpectedLine -> ExpectedLine -> Bool)
-> (ExpectedLine -> ExpectedLine -> Bool) -> Eq ExpectedLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectedLine -> ExpectedLine -> Bool
$c/= :: ExpectedLine -> ExpectedLine -> Bool
== :: ExpectedLine -> ExpectedLine -> Bool
$c== :: ExpectedLine -> ExpectedLine -> Bool
Eq, Int -> ExpectedLine -> ShowS
[ExpectedLine] -> ShowS
ExpectedLine -> String
(Int -> ExpectedLine -> ShowS)
-> (ExpectedLine -> String)
-> ([ExpectedLine] -> ShowS)
-> Show ExpectedLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedLine] -> ShowS
$cshowList :: [ExpectedLine] -> ShowS
show :: ExpectedLine -> String
$cshow :: ExpectedLine -> String
showsPrec :: Int -> ExpectedLine -> ShowS
$cshowsPrec :: Int -> ExpectedLine -> ShowS
Show, (forall x. ExpectedLine -> Rep ExpectedLine x)
-> (forall x. Rep ExpectedLine x -> ExpectedLine)
-> Generic ExpectedLine
forall x. Rep ExpectedLine x -> ExpectedLine
forall x. ExpectedLine -> Rep ExpectedLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExpectedLine x -> ExpectedLine
$cfrom :: forall x. ExpectedLine -> Rep ExpectedLine x
Generic, Value -> Parser [ExpectedLine]
Value -> Parser ExpectedLine
(Value -> Parser ExpectedLine)
-> (Value -> Parser [ExpectedLine]) -> FromJSON ExpectedLine
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExpectedLine]
$cparseJSONList :: Value -> Parser [ExpectedLine]
parseJSON :: Value -> Parser ExpectedLine
$cparseJSON :: Value -> Parser ExpectedLine
FromJSON, [ExpectedLine] -> Encoding
[ExpectedLine] -> Value
ExpectedLine -> Encoding
ExpectedLine -> Value
(ExpectedLine -> Value)
-> (ExpectedLine -> Encoding)
-> ([ExpectedLine] -> Value)
-> ([ExpectedLine] -> Encoding)
-> ToJSON ExpectedLine
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExpectedLine] -> Encoding
$ctoEncodingList :: [ExpectedLine] -> Encoding
toJSONList :: [ExpectedLine] -> Value
$ctoJSONList :: [ExpectedLine] -> Value
toEncoding :: ExpectedLine -> Encoding
$ctoEncoding :: ExpectedLine -> Encoding
toJSON :: ExpectedLine -> Value
$ctoJSON :: ExpectedLine -> Value
ToJSON, ExpectedLine -> ()
(ExpectedLine -> ()) -> NFData ExpectedLine
forall a. (a -> ()) -> NFData a
rnf :: ExpectedLine -> ()
$crnf :: ExpectedLine -> ()
NFData)

instance IsString ExpectedLine where
    fromString :: String -> ExpectedLine
fromString = [LineChunk] -> ExpectedLine
ExpectedLine ([LineChunk] -> ExpectedLine)
-> (String -> [LineChunk]) -> String -> ExpectedLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineChunk -> [LineChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return (LineChunk -> [LineChunk])
-> (String -> LineChunk) -> String -> [LineChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LineChunk
LineChunk

data LineChunk = LineChunk String | WildCardChunk
    deriving (LineChunk -> LineChunk -> Bool
(LineChunk -> LineChunk -> Bool)
-> (LineChunk -> LineChunk -> Bool) -> Eq LineChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineChunk -> LineChunk -> Bool
$c/= :: LineChunk -> LineChunk -> Bool
== :: LineChunk -> LineChunk -> Bool
$c== :: LineChunk -> LineChunk -> Bool
Eq, Int -> LineChunk -> ShowS
[LineChunk] -> ShowS
LineChunk -> String
(Int -> LineChunk -> ShowS)
-> (LineChunk -> String)
-> ([LineChunk] -> ShowS)
-> Show LineChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineChunk] -> ShowS
$cshowList :: [LineChunk] -> ShowS
show :: LineChunk -> String
$cshow :: LineChunk -> String
showsPrec :: Int -> LineChunk -> ShowS
$cshowsPrec :: Int -> LineChunk -> ShowS
Show, (forall x. LineChunk -> Rep LineChunk x)
-> (forall x. Rep LineChunk x -> LineChunk) -> Generic LineChunk
forall x. Rep LineChunk x -> LineChunk
forall x. LineChunk -> Rep LineChunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineChunk x -> LineChunk
$cfrom :: forall x. LineChunk -> Rep LineChunk x
Generic, Value -> Parser [LineChunk]
Value -> Parser LineChunk
(Value -> Parser LineChunk)
-> (Value -> Parser [LineChunk]) -> FromJSON LineChunk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LineChunk]
$cparseJSONList :: Value -> Parser [LineChunk]
parseJSON :: Value -> Parser LineChunk
$cparseJSON :: Value -> Parser LineChunk
FromJSON, [LineChunk] -> Encoding
[LineChunk] -> Value
LineChunk -> Encoding
LineChunk -> Value
(LineChunk -> Value)
-> (LineChunk -> Encoding)
-> ([LineChunk] -> Value)
-> ([LineChunk] -> Encoding)
-> ToJSON LineChunk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LineChunk] -> Encoding
$ctoEncodingList :: [LineChunk] -> Encoding
toJSONList :: [LineChunk] -> Value
$ctoJSONList :: [LineChunk] -> Value
toEncoding :: LineChunk -> Encoding
$ctoEncoding :: LineChunk -> Encoding
toJSON :: LineChunk -> Value
$ctoJSON :: LineChunk -> Value
ToJSON, LineChunk -> ()
(LineChunk -> ()) -> NFData LineChunk
forall a. (a -> ()) -> NFData a
rnf :: LineChunk -> ()
$crnf :: LineChunk -> ()
NFData)

instance IsString LineChunk where
    fromString :: String -> LineChunk
fromString = String -> LineChunk
LineChunk