{-# 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 {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 Sections = Sections
    { Sections -> [Section]
nonSetupSections :: [Section]
    , Sections -> [Section]
setupSections    :: [Section]
    }
    deriving (Int -> Sections -> ShowS
[Sections] -> ShowS
Sections -> String
(Int -> Sections -> ShowS)
-> (Sections -> String) -> ([Sections] -> ShowS) -> Show Sections
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sections] -> ShowS
$cshowList :: [Sections] -> ShowS
show :: Sections -> String
$cshow :: Sections -> String
showsPrec :: Int -> Sections -> ShowS
$cshowsPrec :: Int -> Sections -> ShowS
Show, Sections -> Sections -> Bool
(Sections -> Sections -> Bool)
-> (Sections -> Sections -> Bool) -> Eq Sections
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. Sections -> Rep Sections x)
-> (forall x. Rep Sections x -> Sections) -> Generic Sections
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
(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
. [Test] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Test] -> Bool) -> (Section -> [Test]) -> Section -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> [Test]
sectionTests

hasPropertyTest :: Section -> Bool
hasPropertyTest :: Section -> Bool
hasPropertyTest = (Test -> Bool) -> [Test] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Test -> Bool
isProperty ([Test] -> Bool) -> (Section -> [Test]) -> Section -> Bool
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 = (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], Test -> Range
testRange :: Range}
    | Property {Test -> String
testline :: Txt, testOutput :: [Txt], testRange :: Range}
    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)

data GetEvalComments = GetEvalComments
    deriving (GetEvalComments -> GetEvalComments -> Bool
(GetEvalComments -> GetEvalComments -> Bool)
-> (GetEvalComments -> GetEvalComments -> Bool)
-> Eq GetEvalComments
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, Int -> GetEvalComments -> ShowS
[GetEvalComments] -> ShowS
GetEvalComments -> String
(Int -> GetEvalComments -> ShowS)
-> (GetEvalComments -> String)
-> ([GetEvalComments] -> ShowS)
-> Show GetEvalComments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEvalComments] -> ShowS
$cshowList :: [GetEvalComments] -> ShowS
show :: GetEvalComments -> String
$cshow :: GetEvalComments -> String
showsPrec :: Int -> GetEvalComments -> ShowS
$cshowsPrec :: Int -> GetEvalComments -> ShowS
Show, Typeable, (forall x. GetEvalComments -> Rep GetEvalComments x)
-> (forall x. Rep GetEvalComments x -> GetEvalComments)
-> Generic GetEvalComments
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 (Int -> Comments -> ShowS
[Comments] -> ShowS
Comments -> String
(Int -> Comments -> ShowS)
-> (Comments -> String) -> ([Comments] -> ShowS) -> Show Comments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comments] -> ShowS
$cshowList :: [Comments] -> ShowS
show :: Comments -> String
$cshow :: Comments -> String
showsPrec :: Int -> Comments -> ShowS
$cshowsPrec :: Int -> Comments -> ShowS
Show, Comments -> Comments -> Bool
(Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool) -> Eq Comments
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
Eq Comments
-> (Comments -> Comments -> Ordering)
-> (Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool)
-> (Comments -> Comments -> Comments)
-> (Comments -> Comments -> Comments)
-> Ord 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
$cp1Ord :: Eq Comments
Ord, (forall x. Comments -> Rep Comments x)
-> (forall x. Rep Comments x -> Comments) -> Generic Comments
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
..} = Map Range RawLineComment -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Range RawLineComment
lineComments Bool -> Bool -> Bool
&& Map Range RawBlockComment -> 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 (Int -> RawBlockComment -> ShowS
[RawBlockComment] -> ShowS
RawBlockComment -> String
(Int -> RawBlockComment -> ShowS)
-> (RawBlockComment -> String)
-> ([RawBlockComment] -> ShowS)
-> Show RawBlockComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawBlockComment] -> ShowS
$cshowList :: [RawBlockComment] -> ShowS
show :: RawBlockComment -> String
$cshow :: RawBlockComment -> String
showsPrec :: Int -> RawBlockComment -> ShowS
$cshowsPrec :: Int -> RawBlockComment -> ShowS
Show, RawBlockComment -> RawBlockComment -> Bool
(RawBlockComment -> RawBlockComment -> Bool)
-> (RawBlockComment -> RawBlockComment -> Bool)
-> Eq RawBlockComment
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
Eq RawBlockComment
-> (RawBlockComment -> RawBlockComment -> Ordering)
-> (RawBlockComment -> RawBlockComment -> Bool)
-> (RawBlockComment -> RawBlockComment -> Bool)
-> (RawBlockComment -> RawBlockComment -> Bool)
-> (RawBlockComment -> RawBlockComment -> Bool)
-> (RawBlockComment -> RawBlockComment -> RawBlockComment)
-> (RawBlockComment -> RawBlockComment -> RawBlockComment)
-> Ord 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
$cp1Ord :: Eq RawBlockComment
Ord)
    deriving newtype
        ( String -> RawBlockComment
(String -> RawBlockComment) -> IsString RawBlockComment
forall a. (String -> a) -> IsString a
fromString :: String -> RawBlockComment
$cfromString :: String -> RawBlockComment
IsString
        , Ord (Tokens RawBlockComment)
Ord (Token RawBlockComment)
Ord (Token RawBlockComment)
-> Ord (Tokens RawBlockComment)
-> (Proxy RawBlockComment
    -> Token RawBlockComment -> Tokens RawBlockComment)
-> (Proxy RawBlockComment
    -> [Token RawBlockComment] -> Tokens RawBlockComment)
-> (Proxy RawBlockComment
    -> Tokens RawBlockComment -> [Token RawBlockComment])
-> (Proxy RawBlockComment -> Tokens RawBlockComment -> Int)
-> (Proxy RawBlockComment -> Tokens RawBlockComment -> Bool)
-> (RawBlockComment
    -> Maybe (Token RawBlockComment, RawBlockComment))
-> (Int
    -> RawBlockComment
    -> Maybe (Tokens RawBlockComment, RawBlockComment))
-> ((Token RawBlockComment -> Bool)
    -> RawBlockComment -> (Tokens RawBlockComment, RawBlockComment))
-> Stream RawBlockComment
Int
-> RawBlockComment
-> Maybe (Tokens RawBlockComment, RawBlockComment)
Proxy RawBlockComment
-> [Token RawBlockComment] -> Tokens RawBlockComment
Proxy RawBlockComment -> Tokens RawBlockComment -> Bool
Proxy RawBlockComment -> Tokens RawBlockComment -> Int
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 -> Int)
-> (Proxy s -> Tokens s -> Bool)
-> (s -> Maybe (Token s, s))
-> (Int -> 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_ :: Int
-> RawBlockComment
-> Maybe (Tokens RawBlockComment, RawBlockComment)
$ctakeN_ :: Int
-> 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 -> Int
$cchunkLength :: Proxy RawBlockComment -> Tokens RawBlockComment -> Int
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
$cp2Stream :: Ord (Tokens RawBlockComment)
$cp1Stream :: Ord (Token RawBlockComment)
P.Stream
        , Stream RawBlockComment
Int
-> PosState RawBlockComment
-> (Maybe String, PosState RawBlockComment)
Int -> PosState RawBlockComment -> PosState RawBlockComment
Stream RawBlockComment
-> (Int
    -> PosState RawBlockComment
    -> (Maybe String, PosState RawBlockComment))
-> (Int -> PosState RawBlockComment -> PosState RawBlockComment)
-> TraversableStream RawBlockComment
forall s.
Stream s
-> (Int -> PosState s -> (Maybe String, PosState s))
-> (Int -> PosState s -> PosState s)
-> TraversableStream s
reachOffsetNoLine :: Int -> PosState RawBlockComment -> PosState RawBlockComment
$creachOffsetNoLine :: Int -> PosState RawBlockComment -> PosState RawBlockComment
reachOffset :: Int
-> PosState RawBlockComment
-> (Maybe String, PosState RawBlockComment)
$creachOffset :: Int
-> PosState RawBlockComment
-> (Maybe String, PosState RawBlockComment)
$cp1TraversableStream :: Stream RawBlockComment
P.TraversableStream
        , Stream RawBlockComment
Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> Int
Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> String
Stream RawBlockComment
-> (Proxy RawBlockComment
    -> NonEmpty (Token RawBlockComment) -> String)
-> (Proxy RawBlockComment
    -> NonEmpty (Token RawBlockComment) -> Int)
-> VisualStream RawBlockComment
forall s.
Stream s
-> (Proxy s -> NonEmpty (Token s) -> String)
-> (Proxy s -> NonEmpty (Token s) -> Int)
-> VisualStream s
tokensLength :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> Int
$ctokensLength :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> Int
showTokens :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> String
$cshowTokens :: Proxy RawBlockComment -> NonEmpty (Token RawBlockComment) -> String
$cp1VisualStream :: Stream RawBlockComment
P.VisualStream
        , b -> RawBlockComment -> RawBlockComment
NonEmpty RawBlockComment -> RawBlockComment
RawBlockComment -> RawBlockComment -> RawBlockComment
(RawBlockComment -> RawBlockComment -> RawBlockComment)
-> (NonEmpty RawBlockComment -> RawBlockComment)
-> (forall b.
    Integral b =>
    b -> RawBlockComment -> RawBlockComment)
-> Semigroup 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 :: 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
Semigroup RawBlockComment
-> RawBlockComment
-> (RawBlockComment -> RawBlockComment -> RawBlockComment)
-> ([RawBlockComment] -> RawBlockComment)
-> Monoid 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
$cp1Monoid :: Semigroup RawBlockComment
Monoid
        , RawBlockComment -> ()
(RawBlockComment -> ()) -> NFData RawBlockComment
forall a. (a -> ()) -> NFData a
rnf :: RawBlockComment -> ()
$crnf :: RawBlockComment -> ()
NFData
        )

newtype RawLineComment = RawLineComment {RawLineComment -> String
getRawLineComment :: String}
    deriving (Int -> RawLineComment -> ShowS
[RawLineComment] -> ShowS
RawLineComment -> String
(Int -> RawLineComment -> ShowS)
-> (RawLineComment -> String)
-> ([RawLineComment] -> ShowS)
-> Show RawLineComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawLineComment] -> ShowS
$cshowList :: [RawLineComment] -> ShowS
show :: RawLineComment -> String
$cshow :: RawLineComment -> String
showsPrec :: Int -> RawLineComment -> ShowS
$cshowsPrec :: Int -> RawLineComment -> ShowS
Show, RawLineComment -> RawLineComment -> Bool
(RawLineComment -> RawLineComment -> Bool)
-> (RawLineComment -> RawLineComment -> Bool) -> Eq RawLineComment
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
Eq RawLineComment
-> (RawLineComment -> RawLineComment -> Ordering)
-> (RawLineComment -> RawLineComment -> Bool)
-> (RawLineComment -> RawLineComment -> Bool)
-> (RawLineComment -> RawLineComment -> Bool)
-> (RawLineComment -> RawLineComment -> Bool)
-> (RawLineComment -> RawLineComment -> RawLineComment)
-> (RawLineComment -> RawLineComment -> RawLineComment)
-> Ord 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
$cp1Ord :: Eq RawLineComment
Ord)
    deriving newtype
        ( String -> RawLineComment
(String -> RawLineComment) -> IsString RawLineComment
forall a. (String -> a) -> IsString a
fromString :: String -> RawLineComment
$cfromString :: String -> RawLineComment
IsString
        , Ord (Tokens RawLineComment)
Ord (Token RawLineComment)
Ord (Token RawLineComment)
-> Ord (Tokens RawLineComment)
-> (Proxy RawLineComment
    -> Token RawLineComment -> Tokens RawLineComment)
-> (Proxy RawLineComment
    -> [Token RawLineComment] -> Tokens RawLineComment)
-> (Proxy RawLineComment
    -> Tokens RawLineComment -> [Token RawLineComment])
-> (Proxy RawLineComment -> Tokens RawLineComment -> Int)
-> (Proxy RawLineComment -> Tokens RawLineComment -> Bool)
-> (RawLineComment -> Maybe (Token RawLineComment, RawLineComment))
-> (Int
    -> RawLineComment -> Maybe (Tokens RawLineComment, RawLineComment))
-> ((Token RawLineComment -> Bool)
    -> RawLineComment -> (Tokens RawLineComment, RawLineComment))
-> Stream RawLineComment
Int
-> RawLineComment -> Maybe (Tokens RawLineComment, RawLineComment)
Proxy RawLineComment
-> [Token RawLineComment] -> Tokens RawLineComment
Proxy RawLineComment -> Tokens RawLineComment -> Bool
Proxy RawLineComment -> Tokens RawLineComment -> Int
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 -> Int)
-> (Proxy s -> Tokens s -> Bool)
-> (s -> Maybe (Token s, s))
-> (Int -> 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_ :: Int
-> RawLineComment -> Maybe (Tokens RawLineComment, RawLineComment)
$ctakeN_ :: Int
-> 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 -> Int
$cchunkLength :: Proxy RawLineComment -> Tokens RawLineComment -> Int
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
$cp2Stream :: Ord (Tokens RawLineComment)
$cp1Stream :: Ord (Token RawLineComment)
P.Stream
        , Stream RawLineComment
Int
-> PosState RawLineComment
-> (Maybe String, PosState RawLineComment)
Int -> PosState RawLineComment -> PosState RawLineComment
Stream RawLineComment
-> (Int
    -> PosState RawLineComment
    -> (Maybe String, PosState RawLineComment))
-> (Int -> PosState RawLineComment -> PosState RawLineComment)
-> TraversableStream RawLineComment
forall s.
Stream s
-> (Int -> PosState s -> (Maybe String, PosState s))
-> (Int -> PosState s -> PosState s)
-> TraversableStream s
reachOffsetNoLine :: Int -> PosState RawLineComment -> PosState RawLineComment
$creachOffsetNoLine :: Int -> PosState RawLineComment -> PosState RawLineComment
reachOffset :: Int
-> PosState RawLineComment
-> (Maybe String, PosState RawLineComment)
$creachOffset :: Int
-> PosState RawLineComment
-> (Maybe String, PosState RawLineComment)
$cp1TraversableStream :: Stream RawLineComment
P.TraversableStream
        , Stream RawLineComment
Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> Int
Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> String
Stream RawLineComment
-> (Proxy RawLineComment
    -> NonEmpty (Token RawLineComment) -> String)
-> (Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> Int)
-> VisualStream RawLineComment
forall s.
Stream s
-> (Proxy s -> NonEmpty (Token s) -> String)
-> (Proxy s -> NonEmpty (Token s) -> Int)
-> VisualStream s
tokensLength :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> Int
$ctokensLength :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> Int
showTokens :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> String
$cshowTokens :: Proxy RawLineComment -> NonEmpty (Token RawLineComment) -> String
$cp1VisualStream :: Stream RawLineComment
P.VisualStream
        , b -> RawLineComment -> RawLineComment
NonEmpty RawLineComment -> RawLineComment
RawLineComment -> RawLineComment -> RawLineComment
(RawLineComment -> RawLineComment -> RawLineComment)
-> (NonEmpty RawLineComment -> RawLineComment)
-> (forall b. Integral b => b -> RawLineComment -> RawLineComment)
-> Semigroup 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 :: 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
Semigroup RawLineComment
-> RawLineComment
-> (RawLineComment -> RawLineComment -> RawLineComment)
-> ([RawLineComment] -> RawLineComment)
-> Monoid 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
$cp1Monoid :: Semigroup RawLineComment
Monoid
        , RawLineComment -> ()
(RawLineComment -> ()) -> NFData 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 Map Range RawLineComment
-> Map Range RawLineComment -> Map Range RawLineComment
forall a. Semigroup a => a -> a -> a
<> Map Range RawLineComment
ls') (Map Range RawBlockComment
bs Map Range RawBlockComment
-> Map Range RawBlockComment -> Map Range RawBlockComment
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 Map Range RawLineComment
forall a. Monoid a => a
mempty Map Range RawBlockComment
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
(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

type EvalId = Int

-- | Specify the test section to execute
data EvalParams = EvalParams
    { EvalParams -> [Section]
sections :: [Section]
    , EvalParams -> TextDocumentIdentifier
module_  :: !TextDocumentIdentifier
    , EvalParams -> Int
evalId   :: !EvalId -- ^ unique group id; for test uses
    }
    deriving (EvalParams -> EvalParams -> Bool
(EvalParams -> EvalParams -> Bool)
-> (EvalParams -> EvalParams -> Bool) -> Eq EvalParams
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, Int -> EvalParams -> ShowS
[EvalParams] -> ShowS
EvalParams -> String
(Int -> EvalParams -> ShowS)
-> (EvalParams -> String)
-> ([EvalParams] -> ShowS)
-> Show EvalParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalParams] -> ShowS
$cshowList :: [EvalParams] -> ShowS
show :: EvalParams -> String
$cshow :: EvalParams -> String
showsPrec :: Int -> EvalParams -> ShowS
$cshowsPrec :: Int -> EvalParams -> ShowS
Show, (forall x. EvalParams -> Rep EvalParams x)
-> (forall x. Rep EvalParams x -> EvalParams) -> Generic EvalParams
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
(Value -> Parser EvalParams)
-> (Value -> Parser [EvalParams]) -> FromJSON 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
(EvalParams -> Value)
-> (EvalParams -> Encoding)
-> ([EvalParams] -> Value)
-> ([EvalParams] -> Encoding)
-> ToJSON EvalParams
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)