{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE RecordWildCards            #-}

module Ide.Plugin.Eval.Types
    ( locate,
      locate0,
      Test (..),
      isProperty,
      Format (..),
      Language (..),
      Section (..),
      Sections (..),
      hasTests,
      hasPropertyTest,
      splitSections,
      Loc,
      Located (..),
      Comments (..),
      RawBlockComment (..),
      RawLineComment (..),
      unLoc,
      Txt,
      EvalParams(..),
      GetEvalComments(..)
    ,nullComments)
where

import           Control.DeepSeq               (deepseq)
import           Data.Aeson                    (FromJSON, ToJSON)
import           Data.List                     (partition)
import           Data.List.NonEmpty            (NonEmpty)
import           Data.Map.Strict               (Map)
import           Data.String                   (IsString (..))
import           Development.IDE               (Range, RuleResult)
import           Development.IDE.Graph.Classes
import           GHC.Generics                  (Generic)
import           Language.LSP.Types            (TextDocumentIdentifier)
import qualified Text.Megaparsec               as P

-- | A thing with a location attached.
data Located l a = Located {forall l a. Located l a -> l
location :: l, forall l a. Located l a -> a
located :: a}
    deriving (Located l a -> Located l a -> Bool
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, EvalId -> Located l a -> ShowS
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l a. (Show l, Show a) => EvalId -> 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 :: EvalId -> Located l a -> ShowS
$cshowsPrec :: forall l a. (Show l, Show a) => EvalId -> Located l a -> ShowS
Show, Located l a -> Located l a -> Bool
Located l a -> Located l a -> Ordering
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
Ord, 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
<$ :: forall a b. a -> Located l b -> Located l a
$c<$ :: forall l a b. a -> Located l b -> Located l a
fmap :: forall a b. (a -> b) -> Located l a -> Located l b
$cfmap :: forall l a b. (a -> b) -> Located l a -> Located l b
Functor, 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, 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, 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 :: forall l a. 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 forall a b. NFData a => a -> b -> b
`deepseq` a
a forall a b. NFData a => a -> b -> b
`deepseq` ()

type Loc = Located Line

type Line = Int

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

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

type Txt = String

data Sections = Sections
    { Sections -> [Section]
nonSetupSections :: [Section]
    , Sections -> [Section]
setupSections    :: [Section]
    }
    deriving (EvalId -> Sections -> ShowS
[Sections] -> ShowS
Sections -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sections] -> ShowS
$cshowList :: [Sections] -> ShowS
show :: Sections -> String
$cshow :: Sections -> String
showsPrec :: EvalId -> Sections -> ShowS
$cshowsPrec :: EvalId -> Sections -> ShowS
Show, Sections -> Sections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sections -> Sections -> Bool
$c/= :: Sections -> Sections -> Bool
== :: Sections -> Sections -> Bool
$c== :: Sections -> Sections -> Bool
Eq, forall x. Rep Sections x -> Sections
forall x. Sections -> Rep Sections x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sections x -> Sections
$cfrom :: forall x. Sections -> Rep Sections x
Generic)

data Section = Section
    { Section -> String
sectionName     :: Txt
    , Section -> [Test]
sectionTests    :: [Test]
    , Section -> Language
sectionLanguage :: Language
    , Section -> Format
sectionFormat   :: Format
    }
    deriving (Section -> Section -> Bool
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, EvalId -> Section -> ShowS
[Section] -> ShowS
Section -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: EvalId -> Section -> ShowS
$cshowsPrec :: EvalId -> Section -> ShowS
Show, 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Section -> ()
$crnf :: Section -> ()
NFData)

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

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

-- |Split setup and normal sections
splitSections :: [Section] -> ([Section], [Section])
splitSections :: [Section] -> ([Section], [Section])
splitSections = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== String
"setup") 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], Test -> Range
testRange :: Range}
    | Property {Test -> String
testline :: Txt, testOutput :: [Txt], testRange :: Range}
    deriving (Test -> Test -> Bool
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, EvalId -> Test -> ShowS
[Test] -> ShowS
Test -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Test] -> ShowS
$cshowList :: [Test] -> ShowS
show :: Test -> String
$cshow :: Test -> String
showsPrec :: EvalId -> Test -> ShowS
$cshowsPrec :: EvalId -> Test -> ShowS
Show, 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Test -> ()
$crnf :: Test -> ()
NFData)

data GetEvalComments = GetEvalComments
    deriving (GetEvalComments -> GetEvalComments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEvalComments -> GetEvalComments -> Bool
$c/= :: GetEvalComments -> GetEvalComments -> Bool
== :: GetEvalComments -> GetEvalComments -> Bool
$c== :: GetEvalComments -> GetEvalComments -> Bool
Eq, EvalId -> GetEvalComments -> ShowS
[GetEvalComments] -> ShowS
GetEvalComments -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEvalComments] -> ShowS
$cshowList :: [GetEvalComments] -> ShowS
show :: GetEvalComments -> String
$cshow :: GetEvalComments -> String
showsPrec :: EvalId -> GetEvalComments -> ShowS
$cshowsPrec :: EvalId -> GetEvalComments -> ShowS
Show, Typeable, forall x. Rep GetEvalComments x -> GetEvalComments
forall x. GetEvalComments -> Rep GetEvalComments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEvalComments x -> GetEvalComments
$cfrom :: forall x. GetEvalComments -> Rep GetEvalComments x
Generic)
instance Hashable GetEvalComments
instance NFData   GetEvalComments

type instance RuleResult GetEvalComments = Comments
data Comments = Comments
    { Comments -> Map Range RawLineComment
lineComments  :: Map Range RawLineComment
    , Comments -> Map Range RawBlockComment
blockComments :: Map Range RawBlockComment
    }
    deriving (EvalId -> Comments -> ShowS
[Comments] -> ShowS
Comments -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comments] -> ShowS
$cshowList :: [Comments] -> ShowS
show :: Comments -> String
$cshow :: Comments -> String
showsPrec :: EvalId -> Comments -> ShowS
$cshowsPrec :: EvalId -> Comments -> ShowS
Show, Comments -> Comments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comments -> Comments -> Bool
$c/= :: Comments -> Comments -> Bool
== :: Comments -> Comments -> Bool
$c== :: Comments -> Comments -> Bool
Eq, Eq Comments
Comments -> Comments -> Bool
Comments -> Comments -> Ordering
Comments -> Comments -> Comments
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 :: Comments -> Comments -> Comments
$cmin :: Comments -> Comments -> Comments
max :: Comments -> Comments -> Comments
$cmax :: Comments -> Comments -> Comments
>= :: Comments -> Comments -> Bool
$c>= :: Comments -> Comments -> Bool
> :: Comments -> Comments -> Bool
$c> :: Comments -> Comments -> Bool
<= :: Comments -> Comments -> Bool
$c<= :: Comments -> Comments -> Bool
< :: Comments -> Comments -> Bool
$c< :: Comments -> Comments -> Bool
compare :: Comments -> Comments -> Ordering
$ccompare :: Comments -> Comments -> Ordering
Ord, forall x. Rep Comments x -> Comments
forall x. Comments -> Rep Comments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Comments x -> Comments
$cfrom :: forall x. Comments -> Rep Comments x
Generic)

nullComments :: Comments -> Bool
nullComments :: Comments -> Bool
nullComments Comments{Map Range RawLineComment
Map Range RawBlockComment
blockComments :: Map Range RawBlockComment
lineComments :: Map Range RawLineComment
blockComments :: Comments -> Map Range RawBlockComment
lineComments :: Comments -> Map Range RawLineComment
..} = forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Range RawLineComment
lineComments Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Range RawBlockComment
blockComments

instance NFData Comments

newtype RawBlockComment = RawBlockComment {RawBlockComment -> String
getRawBlockComment :: String}
    deriving (EvalId -> RawBlockComment -> ShowS
[RawBlockComment] -> ShowS
RawBlockComment -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawBlockComment] -> ShowS
$cshowList :: [RawBlockComment] -> ShowS
show :: RawBlockComment -> String
$cshow :: RawBlockComment -> String
showsPrec :: EvalId -> RawBlockComment -> ShowS
$cshowsPrec :: EvalId -> RawBlockComment -> ShowS
Show, RawBlockComment -> RawBlockComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawBlockComment -> RawBlockComment -> Bool
$c/= :: RawBlockComment -> RawBlockComment -> Bool
== :: RawBlockComment -> RawBlockComment -> Bool
$c== :: RawBlockComment -> RawBlockComment -> Bool
Eq, Eq RawBlockComment
RawBlockComment -> RawBlockComment -> Bool
RawBlockComment -> RawBlockComment -> Ordering
RawBlockComment -> RawBlockComment -> RawBlockComment
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 :: RawBlockComment -> RawBlockComment -> RawBlockComment
$cmin :: RawBlockComment -> RawBlockComment -> RawBlockComment
max :: RawBlockComment -> RawBlockComment -> RawBlockComment
$cmax :: RawBlockComment -> RawBlockComment -> RawBlockComment
>= :: RawBlockComment -> RawBlockComment -> Bool
$c>= :: RawBlockComment -> RawBlockComment -> Bool
> :: RawBlockComment -> RawBlockComment -> Bool
$c> :: RawBlockComment -> RawBlockComment -> Bool
<= :: RawBlockComment -> RawBlockComment -> Bool
$c<= :: RawBlockComment -> RawBlockComment -> Bool
< :: RawBlockComment -> RawBlockComment -> Bool
$c< :: RawBlockComment -> RawBlockComment -> Bool
compare :: RawBlockComment -> RawBlockComment -> Ordering
$ccompare :: RawBlockComment -> RawBlockComment -> Ordering
Ord)
    deriving newtype
        ( String -> RawBlockComment
forall a. (String -> a) -> IsString a
fromString :: String -> RawBlockComment
$cfromString :: String -> RawBlockComment
IsString
        , Ord (Tokens RawBlockComment)
Ord (Token RawBlockComment)
EvalId
-> RawBlockComment
-> Maybe (Tokens RawBlockComment, RawBlockComment)
Proxy RawBlockComment
-> [Token RawBlockComment] -> Tokens RawBlockComment
Proxy RawBlockComment -> Tokens RawBlockComment -> Bool
Proxy RawBlockComment -> Tokens RawBlockComment -> EvalId
Proxy RawBlockComment
-> Tokens RawBlockComment -> [Token RawBlockComment]
Proxy RawBlockComment
-> Token RawBlockComment -> Tokens RawBlockComment
RawBlockComment -> Maybe (Token RawBlockComment, RawBlockComment)
(Token RawBlockComment -> Bool)
-> RawBlockComment -> (Tokens RawBlockComment, RawBlockComment)
forall s.
Ord (Token s)
-> Ord (Tokens s)
-> (Proxy s -> Token s -> Tokens s)
-> (Proxy s -> [Token s] -> Tokens s)
-> (Proxy s -> Tokens s -> [Token s])
-> (Proxy s -> Tokens s -> EvalId)
-> (Proxy s -> Tokens s -> Bool)
-> (s -> Maybe (Token s, s))
-> (EvalId -> s -> Maybe (Tokens s, s))
-> ((Token s -> Bool) -> s -> (Tokens s, s))
-> Stream s
takeWhile_ :: (Token RawBlockComment -> Bool)
-> RawBlockComment -> (Tokens RawBlockComment, RawBlockComment)
$ctakeWhile_ :: (Token RawBlockComment -> Bool)
-> RawBlockComment -> (Tokens RawBlockComment, RawBlockComment)
takeN_ :: EvalId
-> RawBlockComment
-> Maybe (Tokens RawBlockComment, RawBlockComment)
$ctakeN_ :: EvalId
-> RawBlockComment
-> Maybe (Tokens RawBlockComment, RawBlockComment)
take1_ :: RawBlockComment -> Maybe (Token RawBlockComment, RawBlockComment)
$ctake1_ :: RawBlockComment -> Maybe (Token RawBlockComment, RawBlockComment)
chunkEmpty :: Proxy RawBlockComment -> Tokens RawBlockComment -> Bool
$cchunkEmpty :: Proxy RawBlockComment -> Tokens RawBlockComment -> Bool
chunkLength :: Proxy RawBlockComment -> Tokens RawBlockComment -> EvalId
$cchunkLength :: Proxy RawBlockComment -> Tokens RawBlockComment -> EvalId
chunkToTokens :: Proxy RawBlockComment
-> Tokens RawBlockComment -> [Token RawBlockComment]
$cchunkToTokens :: Proxy RawBlockComment
-> Tokens RawBlockComment -> [Token RawBlockComment]
tokensToChunk :: Proxy RawBlockComment
-> [Token RawBlockComment] -> Tokens RawBlockComment
$ctokensToChunk :: Proxy RawBlockComment
-> [Token RawBlockComment] -> Tokens RawBlockComment
tokenToChunk :: Proxy RawBlockComment
-> Token RawBlockComment -> Tokens RawBlockComment
$ctokenToChunk :: Proxy RawBlockComment
-> Token RawBlockComment -> Tokens RawBlockComment
P.Stream
        , Stream RawBlockComment
EvalId
-> PosState RawBlockComment
-> (Maybe String, PosState RawBlockComment)
EvalId -> PosState RawBlockComment -> PosState RawBlockComment
forall s.
Stream s
-> (EvalId -> PosState s -> (Maybe String, PosState s))
-> (EvalId -> PosState s -> PosState s)
-> TraversableStream s
reachOffsetNoLine :: EvalId -> PosState RawBlockComment -> PosState RawBlockComment
$creachOffsetNoLine :: EvalId -> PosState RawBlockComment -> PosState RawBlockComment
reachOffset :: EvalId
-> PosState RawBlockComment
-> (Maybe String, PosState RawBlockComment)
$creachOffset :: EvalId
-> PosState RawBlockComment
-> (Maybe String, PosState RawBlockComment)
P.TraversableStream
        , Stream RawBlockComment
Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> EvalId
Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> String
forall s.
Stream s
-> (Proxy s -> NonEmpty (Token s) -> String)
-> (Proxy s -> NonEmpty (Token s) -> EvalId)
-> VisualStream s
tokensLength :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> EvalId
$ctokensLength :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> EvalId
showTokens :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> String
$cshowTokens :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> String
P.VisualStream
        , NonEmpty RawBlockComment -> RawBlockComment
RawBlockComment -> RawBlockComment -> RawBlockComment
forall b. Integral b => b -> RawBlockComment -> RawBlockComment
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> RawBlockComment -> RawBlockComment
$cstimes :: forall b. Integral b => b -> RawBlockComment -> RawBlockComment
sconcat :: NonEmpty RawBlockComment -> RawBlockComment
$csconcat :: NonEmpty RawBlockComment -> RawBlockComment
<> :: RawBlockComment -> RawBlockComment -> RawBlockComment
$c<> :: RawBlockComment -> RawBlockComment -> RawBlockComment
Semigroup
        , Semigroup RawBlockComment
RawBlockComment
[RawBlockComment] -> RawBlockComment
RawBlockComment -> RawBlockComment -> RawBlockComment
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [RawBlockComment] -> RawBlockComment
$cmconcat :: [RawBlockComment] -> RawBlockComment
mappend :: RawBlockComment -> RawBlockComment -> RawBlockComment
$cmappend :: RawBlockComment -> RawBlockComment -> RawBlockComment
mempty :: RawBlockComment
$cmempty :: RawBlockComment
Monoid
        , RawBlockComment -> ()
forall a. (a -> ()) -> NFData a
rnf :: RawBlockComment -> ()
$crnf :: RawBlockComment -> ()
NFData
        )

newtype RawLineComment = RawLineComment {RawLineComment -> String
getRawLineComment :: String}
    deriving (EvalId -> RawLineComment -> ShowS
[RawLineComment] -> ShowS
RawLineComment -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawLineComment] -> ShowS
$cshowList :: [RawLineComment] -> ShowS
show :: RawLineComment -> String
$cshow :: RawLineComment -> String
showsPrec :: EvalId -> RawLineComment -> ShowS
$cshowsPrec :: EvalId -> RawLineComment -> ShowS
Show, RawLineComment -> RawLineComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawLineComment -> RawLineComment -> Bool
$c/= :: RawLineComment -> RawLineComment -> Bool
== :: RawLineComment -> RawLineComment -> Bool
$c== :: RawLineComment -> RawLineComment -> Bool
Eq, Eq RawLineComment
RawLineComment -> RawLineComment -> Bool
RawLineComment -> RawLineComment -> Ordering
RawLineComment -> RawLineComment -> RawLineComment
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 :: RawLineComment -> RawLineComment -> RawLineComment
$cmin :: RawLineComment -> RawLineComment -> RawLineComment
max :: RawLineComment -> RawLineComment -> RawLineComment
$cmax :: RawLineComment -> RawLineComment -> RawLineComment
>= :: RawLineComment -> RawLineComment -> Bool
$c>= :: RawLineComment -> RawLineComment -> Bool
> :: RawLineComment -> RawLineComment -> Bool
$c> :: RawLineComment -> RawLineComment -> Bool
<= :: RawLineComment -> RawLineComment -> Bool
$c<= :: RawLineComment -> RawLineComment -> Bool
< :: RawLineComment -> RawLineComment -> Bool
$c< :: RawLineComment -> RawLineComment -> Bool
compare :: RawLineComment -> RawLineComment -> Ordering
$ccompare :: RawLineComment -> RawLineComment -> Ordering
Ord)
    deriving newtype
        ( String -> RawLineComment
forall a. (String -> a) -> IsString a
fromString :: String -> RawLineComment
$cfromString :: String -> RawLineComment
IsString
        , Ord (Tokens RawLineComment)
Ord (Token RawLineComment)
EvalId
-> RawLineComment -> Maybe (Tokens RawLineComment, RawLineComment)
Proxy RawLineComment
-> [Token RawLineComment] -> Tokens RawLineComment
Proxy RawLineComment -> Tokens RawLineComment -> Bool
Proxy RawLineComment -> Tokens RawLineComment -> EvalId
Proxy RawLineComment
-> Tokens RawLineComment -> [Token RawLineComment]
Proxy RawLineComment
-> Token RawLineComment -> Tokens RawLineComment
RawLineComment -> Maybe (Token RawLineComment, RawLineComment)
(Token RawLineComment -> Bool)
-> RawLineComment -> (Tokens RawLineComment, RawLineComment)
forall s.
Ord (Token s)
-> Ord (Tokens s)
-> (Proxy s -> Token s -> Tokens s)
-> (Proxy s -> [Token s] -> Tokens s)
-> (Proxy s -> Tokens s -> [Token s])
-> (Proxy s -> Tokens s -> EvalId)
-> (Proxy s -> Tokens s -> Bool)
-> (s -> Maybe (Token s, s))
-> (EvalId -> s -> Maybe (Tokens s, s))
-> ((Token s -> Bool) -> s -> (Tokens s, s))
-> Stream s
takeWhile_ :: (Token RawLineComment -> Bool)
-> RawLineComment -> (Tokens RawLineComment, RawLineComment)
$ctakeWhile_ :: (Token RawLineComment -> Bool)
-> RawLineComment -> (Tokens RawLineComment, RawLineComment)
takeN_ :: EvalId
-> RawLineComment -> Maybe (Tokens RawLineComment, RawLineComment)
$ctakeN_ :: EvalId
-> RawLineComment -> Maybe (Tokens RawLineComment, RawLineComment)
take1_ :: RawLineComment -> Maybe (Token RawLineComment, RawLineComment)
$ctake1_ :: RawLineComment -> Maybe (Token RawLineComment, RawLineComment)
chunkEmpty :: Proxy RawLineComment -> Tokens RawLineComment -> Bool
$cchunkEmpty :: Proxy RawLineComment -> Tokens RawLineComment -> Bool
chunkLength :: Proxy RawLineComment -> Tokens RawLineComment -> EvalId
$cchunkLength :: Proxy RawLineComment -> Tokens RawLineComment -> EvalId
chunkToTokens :: Proxy RawLineComment
-> Tokens RawLineComment -> [Token RawLineComment]
$cchunkToTokens :: Proxy RawLineComment
-> Tokens RawLineComment -> [Token RawLineComment]
tokensToChunk :: Proxy RawLineComment
-> [Token RawLineComment] -> Tokens RawLineComment
$ctokensToChunk :: Proxy RawLineComment
-> [Token RawLineComment] -> Tokens RawLineComment
tokenToChunk :: Proxy RawLineComment
-> Token RawLineComment -> Tokens RawLineComment
$ctokenToChunk :: Proxy RawLineComment
-> Token RawLineComment -> Tokens RawLineComment
P.Stream
        , Stream RawLineComment
EvalId
-> PosState RawLineComment
-> (Maybe String, PosState RawLineComment)
EvalId -> PosState RawLineComment -> PosState RawLineComment
forall s.
Stream s
-> (EvalId -> PosState s -> (Maybe String, PosState s))
-> (EvalId -> PosState s -> PosState s)
-> TraversableStream s
reachOffsetNoLine :: EvalId -> PosState RawLineComment -> PosState RawLineComment
$creachOffsetNoLine :: EvalId -> PosState RawLineComment -> PosState RawLineComment
reachOffset :: EvalId
-> PosState RawLineComment
-> (Maybe String, PosState RawLineComment)
$creachOffset :: EvalId
-> PosState RawLineComment
-> (Maybe String, PosState RawLineComment)
P.TraversableStream
        , Stream RawLineComment
Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> EvalId
Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> String
forall s.
Stream s
-> (Proxy s -> NonEmpty (Token s) -> String)
-> (Proxy s -> NonEmpty (Token s) -> EvalId)
-> VisualStream s
tokensLength :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> EvalId
$ctokensLength :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> EvalId
showTokens :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> String
$cshowTokens :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> String
P.VisualStream
        , NonEmpty RawLineComment -> RawLineComment
RawLineComment -> RawLineComment -> RawLineComment
forall b. Integral b => b -> RawLineComment -> RawLineComment
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> RawLineComment -> RawLineComment
$cstimes :: forall b. Integral b => b -> RawLineComment -> RawLineComment
sconcat :: NonEmpty RawLineComment -> RawLineComment
$csconcat :: NonEmpty RawLineComment -> RawLineComment
<> :: RawLineComment -> RawLineComment -> RawLineComment
$c<> :: RawLineComment -> RawLineComment -> RawLineComment
Semigroup
        , Semigroup RawLineComment
RawLineComment
[RawLineComment] -> RawLineComment
RawLineComment -> RawLineComment -> RawLineComment
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [RawLineComment] -> RawLineComment
$cmconcat :: [RawLineComment] -> RawLineComment
mappend :: RawLineComment -> RawLineComment -> RawLineComment
$cmappend :: RawLineComment -> RawLineComment -> RawLineComment
mempty :: RawLineComment
$cmempty :: RawLineComment
Monoid
        , RawLineComment -> ()
forall a. (a -> ()) -> NFData a
rnf :: RawLineComment -> ()
$crnf :: RawLineComment -> ()
NFData
        )

instance Semigroup Comments where
    Comments Map Range RawLineComment
ls Map Range RawBlockComment
bs <> :: Comments -> Comments -> Comments
<> Comments Map Range RawLineComment
ls' Map Range RawBlockComment
bs' = Map Range RawLineComment -> Map Range RawBlockComment -> Comments
Comments (Map Range RawLineComment
ls forall a. Semigroup a => a -> a -> a
<> Map Range RawLineComment
ls') (Map Range RawBlockComment
bs forall a. Semigroup a => a -> a -> a
<> Map Range RawBlockComment
bs')

instance Monoid Comments where
    mempty :: Comments
mempty = Map Range RawLineComment -> Map Range RawBlockComment -> Comments
Comments forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

isProperty :: Test -> Bool
isProperty :: Test -> Bool
isProperty Property {} = Bool
True
isProperty Test
_           = Bool
False

data Format
    = SingleLine
    | -- | @Range@ is that of surrounding entire block comment, not section.
      -- Used for detecting no-newline test commands.
      MultiLine Range
    deriving (Format -> Format -> Bool
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, EvalId -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: EvalId -> Format -> ShowS
$cshowsPrec :: EvalId -> Format -> ShowS
Show, Eq 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
Ord, 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Format -> ()
$crnf :: Format -> ()
NFData)

data Language = Plain | Haddock deriving (Language -> Language -> Bool
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, EvalId -> Language -> ShowS
[Language] -> ShowS
Language -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: EvalId -> Language -> ShowS
$cshowsPrec :: EvalId -> Language -> ShowS
Show, 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
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
Ord, Value -> Parser [Language]
Value -> Parser 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Language -> ()
$crnf :: Language -> ()
NFData)

data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine
    deriving (ExpectedLine -> ExpectedLine -> Bool
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, EvalId -> ExpectedLine -> ShowS
[ExpectedLine] -> ShowS
ExpectedLine -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedLine] -> ShowS
$cshowList :: [ExpectedLine] -> ShowS
show :: ExpectedLine -> String
$cshow :: ExpectedLine -> String
showsPrec :: EvalId -> ExpectedLine -> ShowS
$cshowsPrec :: EvalId -> ExpectedLine -> ShowS
Show, 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: ExpectedLine -> ()
$crnf :: ExpectedLine -> ()
NFData)

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

data LineChunk = LineChunk String | WildCardChunk
    deriving (LineChunk -> LineChunk -> Bool
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, EvalId -> LineChunk -> ShowS
[LineChunk] -> ShowS
LineChunk -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineChunk] -> ShowS
$cshowList :: [LineChunk] -> ShowS
show :: LineChunk -> String
$cshow :: LineChunk -> String
showsPrec :: EvalId -> LineChunk -> ShowS
$cshowsPrec :: EvalId -> LineChunk -> ShowS
Show, 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: LineChunk -> ()
$crnf :: LineChunk -> ()
NFData)

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

type EvalId = Int

-- | Specify the test section to execute
data EvalParams = EvalParams
    { EvalParams -> [Section]
sections :: [Section]
    , EvalParams -> TextDocumentIdentifier
module_  :: !TextDocumentIdentifier
    , EvalParams -> EvalId
evalId   :: !EvalId -- ^ unique group id; for test uses
    }
    deriving (EvalParams -> EvalParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalParams -> EvalParams -> Bool
$c/= :: EvalParams -> EvalParams -> Bool
== :: EvalParams -> EvalParams -> Bool
$c== :: EvalParams -> EvalParams -> Bool
Eq, EvalId -> EvalParams -> ShowS
[EvalParams] -> ShowS
EvalParams -> String
forall a.
(EvalId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalParams] -> ShowS
$cshowList :: [EvalParams] -> ShowS
show :: EvalParams -> String
$cshow :: EvalParams -> String
showsPrec :: EvalId -> EvalParams -> ShowS
$cshowsPrec :: EvalId -> EvalParams -> ShowS
Show, forall x. Rep EvalParams x -> EvalParams
forall x. EvalParams -> Rep EvalParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvalParams x -> EvalParams
$cfrom :: forall x. EvalParams -> Rep EvalParams x
Generic, Value -> Parser [EvalParams]
Value -> Parser EvalParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EvalParams]
$cparseJSONList :: Value -> Parser [EvalParams]
parseJSON :: Value -> Parser EvalParams
$cparseJSON :: Value -> Parser EvalParams
FromJSON, [EvalParams] -> Encoding
[EvalParams] -> Value
EvalParams -> Encoding
EvalParams -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EvalParams] -> Encoding
$ctoEncodingList :: [EvalParams] -> Encoding
toJSONList :: [EvalParams] -> Value
$ctoJSONList :: [EvalParams] -> Value
toEncoding :: EvalParams -> Encoding
$ctoEncoding :: EvalParams -> Encoding
toJSON :: EvalParams -> Value
$ctoJSON :: EvalParams -> Value
ToJSON)