{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Types for working with comments in Swarm programming language.
module Swarm.Language.Syntax.Comments (
  CommentType (..),
  CommentSituation (..),
  isStandalone,
  Comment (..),
  Comments (..),
  beforeComments,
  afterComments,
) where

import Control.Lens (AsEmpty, makeLenses, pattern Empty)
import Data.Aeson qualified as A
import Data.Aeson.Types hiding (Key)
import Data.Data (Data)
import Data.Hashable (Hashable)
import Data.Sequence (Seq)
import Data.Text (Text)
import GHC.Generics (Generic)
import Prettyprinter (pretty)
import Swarm.Language.Syntax.Loc
import Swarm.Pretty (PrettyPrec (..))

-- | Line vs block comments.
data CommentType = LineComment | BlockComment
  deriving (CommentType -> CommentType -> Bool
(CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool) -> Eq CommentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentType -> CommentType -> Bool
== :: CommentType -> CommentType -> Bool
$c/= :: CommentType -> CommentType -> Bool
/= :: CommentType -> CommentType -> Bool
Eq, Eq CommentType
Eq CommentType =>
(CommentType -> CommentType -> Ordering)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> Bool)
-> (CommentType -> CommentType -> CommentType)
-> (CommentType -> CommentType -> CommentType)
-> Ord CommentType
CommentType -> CommentType -> Bool
CommentType -> CommentType -> Ordering
CommentType -> CommentType -> CommentType
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
$ccompare :: CommentType -> CommentType -> Ordering
compare :: CommentType -> CommentType -> Ordering
$c< :: CommentType -> CommentType -> Bool
< :: CommentType -> CommentType -> Bool
$c<= :: CommentType -> CommentType -> Bool
<= :: CommentType -> CommentType -> Bool
$c> :: CommentType -> CommentType -> Bool
> :: CommentType -> CommentType -> Bool
$c>= :: CommentType -> CommentType -> Bool
>= :: CommentType -> CommentType -> Bool
$cmax :: CommentType -> CommentType -> CommentType
max :: CommentType -> CommentType -> CommentType
$cmin :: CommentType -> CommentType -> CommentType
min :: CommentType -> CommentType -> CommentType
Ord, ReadPrec [CommentType]
ReadPrec CommentType
Int -> ReadS CommentType
ReadS [CommentType]
(Int -> ReadS CommentType)
-> ReadS [CommentType]
-> ReadPrec CommentType
-> ReadPrec [CommentType]
-> Read CommentType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommentType
readsPrec :: Int -> ReadS CommentType
$creadList :: ReadS [CommentType]
readList :: ReadS [CommentType]
$creadPrec :: ReadPrec CommentType
readPrec :: ReadPrec CommentType
$creadListPrec :: ReadPrec [CommentType]
readListPrec :: ReadPrec [CommentType]
Read, Int -> CommentType -> ShowS
[CommentType] -> ShowS
CommentType -> String
(Int -> CommentType -> ShowS)
-> (CommentType -> String)
-> ([CommentType] -> ShowS)
-> Show CommentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentType -> ShowS
showsPrec :: Int -> CommentType -> ShowS
$cshow :: CommentType -> String
show :: CommentType -> String
$cshowList :: [CommentType] -> ShowS
showList :: [CommentType] -> ShowS
Show, Int -> CommentType
CommentType -> Int
CommentType -> [CommentType]
CommentType -> CommentType
CommentType -> CommentType -> [CommentType]
CommentType -> CommentType -> CommentType -> [CommentType]
(CommentType -> CommentType)
-> (CommentType -> CommentType)
-> (Int -> CommentType)
-> (CommentType -> Int)
-> (CommentType -> [CommentType])
-> (CommentType -> CommentType -> [CommentType])
-> (CommentType -> CommentType -> [CommentType])
-> (CommentType -> CommentType -> CommentType -> [CommentType])
-> Enum CommentType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CommentType -> CommentType
succ :: CommentType -> CommentType
$cpred :: CommentType -> CommentType
pred :: CommentType -> CommentType
$ctoEnum :: Int -> CommentType
toEnum :: Int -> CommentType
$cfromEnum :: CommentType -> Int
fromEnum :: CommentType -> Int
$cenumFrom :: CommentType -> [CommentType]
enumFrom :: CommentType -> [CommentType]
$cenumFromThen :: CommentType -> CommentType -> [CommentType]
enumFromThen :: CommentType -> CommentType -> [CommentType]
$cenumFromTo :: CommentType -> CommentType -> [CommentType]
enumFromTo :: CommentType -> CommentType -> [CommentType]
$cenumFromThenTo :: CommentType -> CommentType -> CommentType -> [CommentType]
enumFromThenTo :: CommentType -> CommentType -> CommentType -> [CommentType]
Enum, CommentType
CommentType -> CommentType -> Bounded CommentType
forall a. a -> a -> Bounded a
$cminBound :: CommentType
minBound :: CommentType
$cmaxBound :: CommentType
maxBound :: CommentType
Bounded, (forall x. CommentType -> Rep CommentType x)
-> (forall x. Rep CommentType x -> CommentType)
-> Generic CommentType
forall x. Rep CommentType x -> CommentType
forall x. CommentType -> Rep CommentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommentType -> Rep CommentType x
from :: forall x. CommentType -> Rep CommentType x
$cto :: forall x. Rep CommentType x -> CommentType
to :: forall x. Rep CommentType x -> CommentType
Generic, Typeable CommentType
Typeable CommentType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CommentType -> c CommentType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CommentType)
-> (CommentType -> Constr)
-> (CommentType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CommentType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CommentType))
-> ((forall b. Data b => b -> b) -> CommentType -> CommentType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentType -> r)
-> (forall u. (forall d. Data d => d -> u) -> CommentType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CommentType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CommentType -> m CommentType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentType -> m CommentType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentType -> m CommentType)
-> Data CommentType
CommentType -> Constr
CommentType -> DataType
(forall b. Data b => b -> b) -> CommentType -> CommentType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CommentType -> u
forall u. (forall d. Data d => d -> u) -> CommentType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentType -> c CommentType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentType -> c CommentType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentType -> c CommentType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentType
$ctoConstr :: CommentType -> Constr
toConstr :: CommentType -> Constr
$cdataTypeOf :: CommentType -> DataType
dataTypeOf :: CommentType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentType)
$cgmapT :: (forall b. Data b => b -> b) -> CommentType -> CommentType
gmapT :: (forall b. Data b => b -> b) -> CommentType -> CommentType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CommentType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CommentType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentType -> m CommentType
Data, Eq CommentType
Eq CommentType =>
(Int -> CommentType -> Int)
-> (CommentType -> Int) -> Hashable CommentType
Int -> CommentType -> Int
CommentType -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CommentType -> Int
hashWithSalt :: Int -> CommentType -> Int
$chash :: CommentType -> Int
hash :: CommentType -> Int
Hashable, [CommentType] -> Value
[CommentType] -> Encoding
CommentType -> Bool
CommentType -> Value
CommentType -> Encoding
(CommentType -> Value)
-> (CommentType -> Encoding)
-> ([CommentType] -> Value)
-> ([CommentType] -> Encoding)
-> (CommentType -> Bool)
-> ToJSON CommentType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CommentType -> Value
toJSON :: CommentType -> Value
$ctoEncoding :: CommentType -> Encoding
toEncoding :: CommentType -> Encoding
$ctoJSONList :: [CommentType] -> Value
toJSONList :: [CommentType] -> Value
$ctoEncodingList :: [CommentType] -> Encoding
toEncodingList :: [CommentType] -> Encoding
$comitField :: CommentType -> Bool
omitField :: CommentType -> Bool
ToJSON, Maybe CommentType
Value -> Parser [CommentType]
Value -> Parser CommentType
(Value -> Parser CommentType)
-> (Value -> Parser [CommentType])
-> Maybe CommentType
-> FromJSON CommentType
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CommentType
parseJSON :: Value -> Parser CommentType
$cparseJSONList :: Value -> Parser [CommentType]
parseJSONList :: Value -> Parser [CommentType]
$comittedField :: Maybe CommentType
omittedField :: Maybe CommentType
FromJSON)

-- | Was a comment all by itself on a line, or did it occur after some
--   other tokens on a line?
data CommentSituation = StandaloneComment | SuffixComment
  deriving (CommentSituation -> CommentSituation -> Bool
(CommentSituation -> CommentSituation -> Bool)
-> (CommentSituation -> CommentSituation -> Bool)
-> Eq CommentSituation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentSituation -> CommentSituation -> Bool
== :: CommentSituation -> CommentSituation -> Bool
$c/= :: CommentSituation -> CommentSituation -> Bool
/= :: CommentSituation -> CommentSituation -> Bool
Eq, Eq CommentSituation
Eq CommentSituation =>
(CommentSituation -> CommentSituation -> Ordering)
-> (CommentSituation -> CommentSituation -> Bool)
-> (CommentSituation -> CommentSituation -> Bool)
-> (CommentSituation -> CommentSituation -> Bool)
-> (CommentSituation -> CommentSituation -> Bool)
-> (CommentSituation -> CommentSituation -> CommentSituation)
-> (CommentSituation -> CommentSituation -> CommentSituation)
-> Ord CommentSituation
CommentSituation -> CommentSituation -> Bool
CommentSituation -> CommentSituation -> Ordering
CommentSituation -> CommentSituation -> CommentSituation
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
$ccompare :: CommentSituation -> CommentSituation -> Ordering
compare :: CommentSituation -> CommentSituation -> Ordering
$c< :: CommentSituation -> CommentSituation -> Bool
< :: CommentSituation -> CommentSituation -> Bool
$c<= :: CommentSituation -> CommentSituation -> Bool
<= :: CommentSituation -> CommentSituation -> Bool
$c> :: CommentSituation -> CommentSituation -> Bool
> :: CommentSituation -> CommentSituation -> Bool
$c>= :: CommentSituation -> CommentSituation -> Bool
>= :: CommentSituation -> CommentSituation -> Bool
$cmax :: CommentSituation -> CommentSituation -> CommentSituation
max :: CommentSituation -> CommentSituation -> CommentSituation
$cmin :: CommentSituation -> CommentSituation -> CommentSituation
min :: CommentSituation -> CommentSituation -> CommentSituation
Ord, ReadPrec [CommentSituation]
ReadPrec CommentSituation
Int -> ReadS CommentSituation
ReadS [CommentSituation]
(Int -> ReadS CommentSituation)
-> ReadS [CommentSituation]
-> ReadPrec CommentSituation
-> ReadPrec [CommentSituation]
-> Read CommentSituation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommentSituation
readsPrec :: Int -> ReadS CommentSituation
$creadList :: ReadS [CommentSituation]
readList :: ReadS [CommentSituation]
$creadPrec :: ReadPrec CommentSituation
readPrec :: ReadPrec CommentSituation
$creadListPrec :: ReadPrec [CommentSituation]
readListPrec :: ReadPrec [CommentSituation]
Read, Int -> CommentSituation -> ShowS
[CommentSituation] -> ShowS
CommentSituation -> String
(Int -> CommentSituation -> ShowS)
-> (CommentSituation -> String)
-> ([CommentSituation] -> ShowS)
-> Show CommentSituation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentSituation -> ShowS
showsPrec :: Int -> CommentSituation -> ShowS
$cshow :: CommentSituation -> String
show :: CommentSituation -> String
$cshowList :: [CommentSituation] -> ShowS
showList :: [CommentSituation] -> ShowS
Show, Int -> CommentSituation
CommentSituation -> Int
CommentSituation -> [CommentSituation]
CommentSituation -> CommentSituation
CommentSituation -> CommentSituation -> [CommentSituation]
CommentSituation
-> CommentSituation -> CommentSituation -> [CommentSituation]
(CommentSituation -> CommentSituation)
-> (CommentSituation -> CommentSituation)
-> (Int -> CommentSituation)
-> (CommentSituation -> Int)
-> (CommentSituation -> [CommentSituation])
-> (CommentSituation -> CommentSituation -> [CommentSituation])
-> (CommentSituation -> CommentSituation -> [CommentSituation])
-> (CommentSituation
    -> CommentSituation -> CommentSituation -> [CommentSituation])
-> Enum CommentSituation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CommentSituation -> CommentSituation
succ :: CommentSituation -> CommentSituation
$cpred :: CommentSituation -> CommentSituation
pred :: CommentSituation -> CommentSituation
$ctoEnum :: Int -> CommentSituation
toEnum :: Int -> CommentSituation
$cfromEnum :: CommentSituation -> Int
fromEnum :: CommentSituation -> Int
$cenumFrom :: CommentSituation -> [CommentSituation]
enumFrom :: CommentSituation -> [CommentSituation]
$cenumFromThen :: CommentSituation -> CommentSituation -> [CommentSituation]
enumFromThen :: CommentSituation -> CommentSituation -> [CommentSituation]
$cenumFromTo :: CommentSituation -> CommentSituation -> [CommentSituation]
enumFromTo :: CommentSituation -> CommentSituation -> [CommentSituation]
$cenumFromThenTo :: CommentSituation
-> CommentSituation -> CommentSituation -> [CommentSituation]
enumFromThenTo :: CommentSituation
-> CommentSituation -> CommentSituation -> [CommentSituation]
Enum, CommentSituation
CommentSituation -> CommentSituation -> Bounded CommentSituation
forall a. a -> a -> Bounded a
$cminBound :: CommentSituation
minBound :: CommentSituation
$cmaxBound :: CommentSituation
maxBound :: CommentSituation
Bounded, (forall x. CommentSituation -> Rep CommentSituation x)
-> (forall x. Rep CommentSituation x -> CommentSituation)
-> Generic CommentSituation
forall x. Rep CommentSituation x -> CommentSituation
forall x. CommentSituation -> Rep CommentSituation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommentSituation -> Rep CommentSituation x
from :: forall x. CommentSituation -> Rep CommentSituation x
$cto :: forall x. Rep CommentSituation x -> CommentSituation
to :: forall x. Rep CommentSituation x -> CommentSituation
Generic, Typeable CommentSituation
Typeable CommentSituation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CommentSituation -> c CommentSituation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CommentSituation)
-> (CommentSituation -> Constr)
-> (CommentSituation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CommentSituation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CommentSituation))
-> ((forall b. Data b => b -> b)
    -> CommentSituation -> CommentSituation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentSituation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentSituation -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CommentSituation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CommentSituation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CommentSituation -> m CommentSituation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CommentSituation -> m CommentSituation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CommentSituation -> m CommentSituation)
-> Data CommentSituation
CommentSituation -> Constr
CommentSituation -> DataType
(forall b. Data b => b -> b)
-> CommentSituation -> CommentSituation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CommentSituation -> u
forall u. (forall d. Data d => d -> u) -> CommentSituation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentSituation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentSituation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentSituation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentSituation -> c CommentSituation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentSituation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentSituation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentSituation -> c CommentSituation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentSituation -> c CommentSituation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentSituation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentSituation
$ctoConstr :: CommentSituation -> Constr
toConstr :: CommentSituation -> Constr
$cdataTypeOf :: CommentSituation -> DataType
dataTypeOf :: CommentSituation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentSituation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentSituation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentSituation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentSituation)
$cgmapT :: (forall b. Data b => b -> b)
-> CommentSituation -> CommentSituation
gmapT :: (forall b. Data b => b -> b)
-> CommentSituation -> CommentSituation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentSituation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentSituation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentSituation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentSituation -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CommentSituation -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CommentSituation -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CommentSituation -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CommentSituation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CommentSituation -> m CommentSituation
Data, Eq CommentSituation
Eq CommentSituation =>
(Int -> CommentSituation -> Int)
-> (CommentSituation -> Int) -> Hashable CommentSituation
Int -> CommentSituation -> Int
CommentSituation -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CommentSituation -> Int
hashWithSalt :: Int -> CommentSituation -> Int
$chash :: CommentSituation -> Int
hash :: CommentSituation -> Int
Hashable, [CommentSituation] -> Value
[CommentSituation] -> Encoding
CommentSituation -> Bool
CommentSituation -> Value
CommentSituation -> Encoding
(CommentSituation -> Value)
-> (CommentSituation -> Encoding)
-> ([CommentSituation] -> Value)
-> ([CommentSituation] -> Encoding)
-> (CommentSituation -> Bool)
-> ToJSON CommentSituation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CommentSituation -> Value
toJSON :: CommentSituation -> Value
$ctoEncoding :: CommentSituation -> Encoding
toEncoding :: CommentSituation -> Encoding
$ctoJSONList :: [CommentSituation] -> Value
toJSONList :: [CommentSituation] -> Value
$ctoEncodingList :: [CommentSituation] -> Encoding
toEncodingList :: [CommentSituation] -> Encoding
$comitField :: CommentSituation -> Bool
omitField :: CommentSituation -> Bool
ToJSON, Maybe CommentSituation
Value -> Parser [CommentSituation]
Value -> Parser CommentSituation
(Value -> Parser CommentSituation)
-> (Value -> Parser [CommentSituation])
-> Maybe CommentSituation
-> FromJSON CommentSituation
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CommentSituation
parseJSON :: Value -> Parser CommentSituation
$cparseJSONList :: Value -> Parser [CommentSituation]
parseJSONList :: Value -> Parser [CommentSituation]
$comittedField :: Maybe CommentSituation
omittedField :: Maybe CommentSituation
FromJSON)

-- | Test whether a comment is a standalone comment or not.
isStandalone :: Comment -> Bool
isStandalone :: Comment -> Bool
isStandalone = (CommentSituation -> CommentSituation -> Bool
forall a. Eq a => a -> a -> Bool
== CommentSituation
StandaloneComment) (CommentSituation -> Bool)
-> (Comment -> CommentSituation) -> Comment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> CommentSituation
commentSituation

-- | A comment is retained as some text plus metadata (source
--   location, comment type, + comment situation).  While parsing we
--   record all comments out-of-band, for later re-insertion into the
--   AST.
data Comment = Comment
  { Comment -> SrcLoc
commentSrcLoc :: SrcLoc
  , Comment -> CommentType
commentType :: CommentType
  , Comment -> CommentSituation
commentSituation :: CommentSituation
  , Comment -> Text
commentText :: Text
  }
  deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
/= :: Comment -> Comment -> Bool
Eq, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comment -> ShowS
showsPrec :: Int -> Comment -> ShowS
$cshow :: Comment -> String
show :: Comment -> String
$cshowList :: [Comment] -> ShowS
showList :: [Comment] -> ShowS
Show, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Comment -> Rep Comment x
from :: forall x. Comment -> Rep Comment x
$cto :: forall x. Rep Comment x -> Comment
to :: forall x. Rep Comment x -> Comment
Generic, Typeable Comment
Typeable Comment =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Comment -> c Comment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment)
-> (Comment -> Constr)
-> (Comment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment))
-> ((forall b. Data b => b -> b) -> Comment -> Comment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Comment -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> Data Comment
Comment -> Constr
Comment -> DataType
(forall b. Data b => b -> b) -> Comment -> Comment
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
forall u. (forall d. Data d => d -> u) -> Comment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
$ctoConstr :: Comment -> Constr
toConstr :: Comment -> Constr
$cdataTypeOf :: Comment -> DataType
dataTypeOf :: Comment -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
Data, [Comment] -> Value
[Comment] -> Encoding
Comment -> Bool
Comment -> Value
Comment -> Encoding
(Comment -> Value)
-> (Comment -> Encoding)
-> ([Comment] -> Value)
-> ([Comment] -> Encoding)
-> (Comment -> Bool)
-> ToJSON Comment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Comment -> Value
toJSON :: Comment -> Value
$ctoEncoding :: Comment -> Encoding
toEncoding :: Comment -> Encoding
$ctoJSONList :: [Comment] -> Value
toJSONList :: [Comment] -> Value
$ctoEncodingList :: [Comment] -> Encoding
toEncodingList :: [Comment] -> Encoding
$comitField :: Comment -> Bool
omitField :: Comment -> Bool
ToJSON, Maybe Comment
Value -> Parser [Comment]
Value -> Parser Comment
(Value -> Parser Comment)
-> (Value -> Parser [Comment]) -> Maybe Comment -> FromJSON Comment
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Comment
parseJSON :: Value -> Parser Comment
$cparseJSONList :: Value -> Parser [Comment]
parseJSONList :: Value -> Parser [Comment]
$comittedField :: Maybe Comment
omittedField :: Maybe Comment
FromJSON, Eq Comment
Eq Comment =>
(Int -> Comment -> Int) -> (Comment -> Int) -> Hashable Comment
Int -> Comment -> Int
Comment -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Comment -> Int
hashWithSalt :: Int -> Comment -> Int
$chash :: Comment -> Int
hash :: Comment -> Int
Hashable)

instance PrettyPrec Comment where
  prettyPrec :: forall ann. Int -> Comment -> Doc ann
prettyPrec Int
_ (Comment SrcLoc
_ CommentType
LineComment CommentSituation
_ Text
txt) = Doc ann
"//" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
txt
  prettyPrec Int
_ (Comment SrcLoc
_ CommentType
BlockComment CommentSituation
_ Text
txt) = Doc ann
"/*" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
txt Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"*/"

-- | Comments which can be attached to a particular AST node.  Some
--   comments come textually before the node and some come after.
data Comments = Comments
  { Comments -> Seq Comment
_beforeComments :: Seq Comment
  , Comments -> Seq Comment
_afterComments :: Seq Comment
  }
  deriving (Comments -> Comments -> Bool
(Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool) -> Eq Comments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comments -> Comments -> Bool
== :: Comments -> Comments -> Bool
$c/= :: Comments -> Comments -> Bool
/= :: Comments -> Comments -> Bool
Eq, 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
$cshowsPrec :: Int -> Comments -> ShowS
showsPrec :: Int -> Comments -> ShowS
$cshow :: Comments -> String
show :: Comments -> String
$cshowList :: [Comments] -> ShowS
showList :: [Comments] -> ShowS
Show, (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
$cfrom :: forall x. Comments -> Rep Comments x
from :: forall x. Comments -> Rep Comments x
$cto :: forall x. Rep Comments x -> Comments
to :: forall x. Rep Comments x -> Comments
Generic, Typeable Comments
Typeable Comments =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Comments -> c Comments)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comments)
-> (Comments -> Constr)
-> (Comments -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comments))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comments))
-> ((forall b. Data b => b -> b) -> Comments -> Comments)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comments -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comments -> r)
-> (forall u. (forall d. Data d => d -> u) -> Comments -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Comments -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comments -> m Comments)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comments -> m Comments)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comments -> m Comments)
-> Data Comments
Comments -> Constr
Comments -> DataType
(forall b. Data b => b -> b) -> Comments -> Comments
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Comments -> u
forall u. (forall d. Data d => d -> u) -> Comments -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comments -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comments -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comments
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comments -> c Comments
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comments)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comments)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comments -> c Comments
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comments -> c Comments
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comments
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comments
$ctoConstr :: Comments -> Constr
toConstr :: Comments -> Constr
$cdataTypeOf :: Comments -> DataType
dataTypeOf :: Comments -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comments)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comments)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comments)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comments)
$cgmapT :: (forall b. Data b => b -> b) -> Comments -> Comments
gmapT :: (forall b. Data b => b -> b) -> Comments -> Comments
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comments -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comments -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comments -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comments -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comments -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Comments -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comments -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comments -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comments -> m Comments
Data, Eq Comments
Eq Comments =>
(Int -> Comments -> Int) -> (Comments -> Int) -> Hashable Comments
Int -> Comments -> Int
Comments -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Comments -> Int
hashWithSalt :: Int -> Comments -> Int
$chash :: Comments -> Int
hash :: Comments -> Int
Hashable)

makeLenses ''Comments

instance ToJSON Comments where
  toJSON :: Comments -> Value
toJSON = Options -> Comments -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
A.defaultOptions
  omitField :: Comments -> Bool
omitField = \case
    Comments
Empty -> Bool
True
    Comments
_ -> Bool
False

instance FromJSON Comments where
  parseJSON :: Value -> Parser Comments
parseJSON = Options -> Value -> Parser Comments
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
A.defaultOptions
  omittedField :: Maybe Comments
omittedField = Comments -> Maybe Comments
forall a. a -> Maybe a
Just Comments
forall s. AsEmpty s => s
Empty

instance Semigroup Comments where
  Comments Seq Comment
b1 Seq Comment
a1 <> :: Comments -> Comments -> Comments
<> Comments Seq Comment
b2 Seq Comment
a2 = Seq Comment -> Seq Comment -> Comments
Comments (Seq Comment
b1 Seq Comment -> Seq Comment -> Seq Comment
forall a. Semigroup a => a -> a -> a
<> Seq Comment
b2) (Seq Comment
a1 Seq Comment -> Seq Comment -> Seq Comment
forall a. Semigroup a => a -> a -> a
<> Seq Comment
a2)

instance Monoid Comments where
  mempty :: Comments
mempty = Seq Comment -> Seq Comment -> Comments
Comments Seq Comment
forall a. Monoid a => a
mempty Seq Comment
forall a. Monoid a => a
mempty

instance AsEmpty Comments