{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances, PatternGuards, Rank2Types, OverlappingInstances, ScopedTypeVariables, ExistentialQuantification, TypeSynonymInstances, CPP, ViewPatterns, TupleSections #-}

module Cxx.Operations (apply, mapply, squared, parenthesized, is_primary_TypeSpecifier, split_all_decls, map_plain, parseAbbrMain, expand, line_breaks, specT, find, is_pointer_or_reference, namedPathTo, findable_productions, make_edits, ShortCode) where

import qualified Cxx.Show
import qualified Data.List.NonEmpty as NeList
import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)
import qualified Data.Maybe as Maybe
import Util (Convert(..), (.), total_tail, strip, isIdChar, TriBool(..), MaybeEitherString(..), Phantom(..), neElim, NeList, orElse, neFilter, Apply(..), MaybeApply(..), MyMonadError(..))
import Cxx.Basics
import Editing.Basics (Range(..), Offsettable(..), TextEdit(..), Pos(Pos), pos, contained_in, fullRange)
import Editing.Diff (diff_as_Edits)
import Data.Function (on)
import Data.Foldable (toList, any)
import Control.Arrow (first, second)
import Control.Monad.Identity
import Data.Generics (cast, gmapT, everywhere, Data, Typeable, gfoldl, dataTypeOf, toConstr, Constr, DataType, dataTypeName, constrType)

import Prelude hiding ((.), any)
import Prelude.Unicode

-- Operations on Chunks/Code

map_plain :: (String → String) → Chunk → Chunk
map_plain f (Plain s) = Plain $ f s
map_plain f (Curlies c) = Curlies $ map (map_plain f) c
map_plain f (Parens c) = Parens $ map (map_plain f) c
map_plain f (Squares c) = Squares $ map (map_plain f) c
map_plain _ x = x

int_main :: String
int_main = "\nint main(int argc, char * argv[])"

gen :: String → String → String → TString
gen left middle right
   = map (, 0) left
  ++ zip middle [0..]
  ++ map (, length middle) right

generateMain :: AbbreviatedMain → TString
generateMain (Block c) = gen int_main ("{" ++ show c ++ "}") ""
generateMain (Call c) = gen (int_main ++ "{printf") (show c) "\n;}"
generateMain (Print c) = gen (int_main ++ "{::std::cout") ("<<" ++ show c) "\n;}"
  -- The newlines make //-style comments work.

cstyle_comments :: Code → Code
cstyle_comments = map f where f (SingleComment s) = MultiComment s; f c = c

type ShortCode = (Maybe AbbreviatedMain, Code)

instance Show AbbreviatedMain where
  show (Block c) = show [Curlies c]
  show (Call c) = show c
  show (Print c) = show $ [Plain "<<"] ++ c

type TString = [(Char, Int {- position in the request body -})]

expand :: Code -> (Maybe TString {- generated main -}, TString {- rest -})
expand requestChunks =
    ( generateMain . mAbbrMain
    , zip (show rest) [maybe 0 (length . show) mAbbrMain ..])
  where
    (mAbbrMain, rest) = parseAbbrMain requestChunks

parseAbbrMain :: Code → (Maybe AbbreviatedMain, Code)
parseAbbrMain (Curlies c : b) = (Just (Block c), b)
parseAbbrMain (Plain ('<':'<':a) : b) = (Just (Print x), total_tail y)
  where (x, y) = break (== Plain ";") $ Plain a : b
parseAbbrMain (Parens c : b) = (Just (Call (Parens c : x)), total_tail y)
  where (x, y) = break (== Plain ";") b
parseAbbrMain c = (Nothing, c)

line_breaks :: Code → Code
line_breaks = map $ map_plain $ map $ \c → if c == '\\' then '\n' else c

-- Convenience constructors

squared :: a → Squared a
squared x = Squared (OpenSquare_, White "") (Enclosed x) (CloseSquare_, White "")

parenthesized :: a → Parenthesized a
parenthesized x = Parenthesized (OpenParen_, White "") (Enclosed x) (CloseParen_, White "")

specT :: TypeSpecifier
specT = TypeSpecifier_TrailingTypeSpecifier $ TrailingTypeSpecifier_SimpleTypeSpecifier $ SimpleTypeSpecifier_TypeName (OptQualified Nothing Nothing) $ TypeName_ClassName $ ClassName_Identifier $ Identifier "T" $ White " "

-- Applying make-specifications.

apply_makedecl_to :: Data d ⇒ MakeDeclaration → d → MaybeEitherString d
apply_makedecl_to makedecl = Maybe.fromMaybe (const $ MaybeEitherString Nothing) $ Maybe.listToMaybe . Maybe.catMaybes $
  [ cast ((\d → case d of
    SimpleDeclaration specs (Just (InitDeclaratorList (Commad (InitDeclarator x mi) []))) w  →
      case makedecl of
        MakeDeclaration _ _ Definitely → throwError "Cannot purify simple-declaration."
        MakeDeclaration specs' mpad _ → return $ let (specs'', x') = apply (specs', mpad) (specs, x) in
          SimpleDeclaration specs'' (Just (InitDeclaratorList (Commad (InitDeclarator x' mi) []))) w
    _ → MaybeEitherString Nothing) :: SimpleDeclaration → MaybeEitherString SimpleDeclaration)
  , cast (mapply makedecl :: ParameterDeclaration → MaybeEitherString ParameterDeclaration)
  , cast ((\d → case d of
    ExceptionDeclaration u (Just (Left e)) →
      case makedecl of
        MakeDeclaration _ _ Definitely → throwError "Cannot purify exception-declaration."
        MakeDeclaration specs mpad _ →
          (\(u', e') → ExceptionDeclaration u' $ Just $ Left e') . mapply (specs, mpad) (u, e)
    _ → MaybeEitherString Nothing) :: ExceptionDeclaration → MaybeEitherString ExceptionDeclaration)
  , cast ((\d → case d of
    MemberDeclaration specs (Just (MemberDeclaratorList (Commad (MemberDeclarator decl ps) []))) semicolon →
      return $ let (specs', decl', ps') = apply makedecl (specs, decl, ps) in
        MemberDeclaration specs' (Just (MemberDeclaratorList (Commad (MemberDeclarator decl' ps') []))) semicolon
    _ → MaybeEitherString Nothing) :: MemberDeclaration → MaybeEitherString MemberDeclaration)
  , cast (mapply makedecl :: FunctionDefinition → MaybeEitherString FunctionDefinition)
  , cast ((\d → case d of
    Condition_Declaration u e i →
      case makedecl of
        MakeDeclaration _ _ Definitely → throwError "Cannot purify condition-declaration."
        MakeDeclaration specs mpad _ →
          (\(u', e') → Condition_Declaration u' e' i) . mapply (specs, mpad) (u, e)
    _ → MaybeEitherString Nothing) :: Condition → MaybeEitherString Condition)
  , cast (mapply makedecl :: ForRangeDeclaration → MaybeEitherString ForRangeDeclaration)
  ]

-- Getting declarator-ids out of things.

instance Convert ClassSpecifier (Maybe DeclaratorId) where convert (ClassSpecifier h _) = convert h
instance Convert ClassHead (Maybe DeclaratorId) where convert (ClassHead _ k _) = convert k
instance Convert Identifier DeclaratorId where convert = DeclaratorId_IdExpression Nothing . convert
instance Convert Identifier IdExpression where convert = IdExpression . Right . convert
instance Convert Identifier UnqualifiedId where convert = UnqualifiedId_Identifier
instance Convert (NestedNameSpecifier, Identifier) QualifiedId where convert (nns, i) = NestedUnqualifiedId Nothing nns Nothing (convert i)
instance Convert (NestedNameSpecifier, Identifier) IdExpression where convert = IdExpression . Left . convert
instance Convert SimpleTemplateId UnqualifiedId where convert = UnqualifiedId_TemplateId . convert
instance Convert SimpleTemplateId IdExpression where convert = IdExpression . Right . convert
instance Convert SimpleTemplateId DeclaratorId where convert = DeclaratorId_IdExpression Nothing . convert
instance Convert SimpleTemplateId TemplateId where convert = TemplateId_SimpleTemplateId
instance Convert (NestedNameSpecifier, SimpleTemplateId) DeclaratorId where convert = DeclaratorId_IdExpression Nothing . convert
instance Convert (NestedNameSpecifier, SimpleTemplateId) IdExpression where convert = IdExpression . Left . convert
instance Convert (NestedNameSpecifier, SimpleTemplateId) QualifiedId where convert (nns, tid) = NestedUnqualifiedId Nothing nns Nothing (convert tid)
instance Convert ClassHeadKind (Maybe DeclaratorId) where
  convert (ClassHeadKind_Identifier m) = convert . m
  convert (ClassHeadKind_NestedIdentifier nns i) = Just $ DeclaratorId_IdExpression Nothing $ convert (nns, i)
  convert (ClassHeadKind_SimpleTemplateId Nothing i) = Just $ convert i
  convert (ClassHeadKind_SimpleTemplateId (Just nns) i) = Just $ convert (nns, i)
instance Convert EnumSpecifier (Maybe DeclaratorId) where convert (EnumSpecifier x _) = convert x
instance Convert EnumHead (Maybe DeclaratorId) where convert (EnumHead _ m _) = convert . m
instance Convert DeclSpecifier (Maybe DeclaratorId) where
  convert (DeclSpecifier_TypeSpecifier (TypeSpecifier_ClassSpecifier c)) = convert c
  convert (DeclSpecifier_TypeSpecifier (TypeSpecifier_EnumSpecifier c)) = convert c
  convert (DeclSpecifier_TypeSpecifier (TypeSpecifier_TrailingTypeSpecifier (TrailingTypeSpecifier_ElaboratedTypeSpecifier c))) = Just $ convert c
  convert _ = Nothing
instance Convert SimpleDeclaration (Maybe DeclaratorId) where
  convert (SimpleDeclaration _ (Just (InitDeclaratorList (Commad (InitDeclarator d _) []))) _) = Just $ convert d
  convert (SimpleDeclaration (Just (DeclSpecifierSeq (neElim → (d, [])))) Nothing _) = convert d
  convert _ = Nothing
instance Convert NamespaceAliasDefinition DeclaratorId where convert (NamespaceAliasDefinition _ i _ _ _ _) = convert i
instance Convert BlockDeclaration (Maybe DeclaratorId) where
  convert (BlockDeclaration_SimpleDeclaration d) = convert d
  convert (BlockDeclaration_NamespaceAliasDefinition d) = Just $ convert d
  convert (BlockDeclaration_AliasDeclaration d) = Just $ convert d
  convert _ = Nothing
instance Convert ExplicitSpecialization (Maybe DeclaratorId) where convert (ExplicitSpecialization _ _ d) = convert d
instance Convert FunctionDefinition DeclaratorId where convert (FunctionDefinition _ d _) = convert d
instance Convert NamespaceDefinition (Maybe DeclaratorId) where convert (NamespaceDefinition _ _ m _) = convert . m
instance Convert AliasDeclaration DeclaratorId where convert (AliasDeclaration _ i _ _ _) = convert i
instance Convert Declaration (Maybe DeclaratorId) where
  convert (Declaration_BlockDeclaration d) = convert d
  convert (Declaration_FunctionDefinition d) = Just $ convert d
  convert (Declaration_TemplateDeclaration d) = convert d
  convert (Declaration_NamespaceDefinition d) = convert d
  convert (Declaration_ExplicitSpecialization d) = convert d
  convert _ = Nothing
instance Convert TemplateDeclaration (Maybe DeclaratorId) where convert (TemplateDeclaration _ _ _ d) = convert d
instance Convert ExplicitInstantiation (Maybe DeclaratorId) where convert (ExplicitInstantiation _ _ d) = convert d
instance Convert MemberDeclarator (Maybe DeclaratorId) where
  convert (MemberDeclarator d _) = Just $ convert d
  convert (BitField m _ _) = convert . m
instance Convert MemberDeclaration (Maybe DeclaratorId) where
  convert (MemberFunctionDefinition d _) = Just $ convert d
  convert (MemberUsingDeclaration _) = Nothing
  convert (MemberTemplateDeclaration d) = convert d
  convert (MemberDeclaration _ (Just (MemberDeclaratorList (Commad d []))) _) = convert d
  convert (MemberDeclaration (Just (DeclSpecifierSeq (neElim → (d, [])))) Nothing _) = convert d
  convert (MemberDeclaration _ _ _) = Nothing
instance Convert ExceptionDeclaration (Maybe DeclaratorId) where
  convert (ExceptionDeclaration _ (Just (Left d))) = Just $ convert d
  convert _ = Nothing
instance Convert ParameterDeclaration (Maybe DeclaratorId) where
  convert (ParameterDeclaration _ (Left d) _) = Just $ convert d
  convert _ = Nothing
instance Convert Condition (Maybe DeclaratorId) where
  convert (Condition_Declaration _ d _) = Just $ convert d
  convert _ = Nothing
instance Convert ForRangeDeclaration DeclaratorId where
  convert (ForRangeDeclaration _ d) = convert d
instance Convert (OptQualified, Identifier) DeclaratorId where
  convert (OptQualified Nothing Nothing, i) = convert i
  convert (OptQualified (Just s) Nothing, i) = DeclaratorId_IdExpression Nothing $ IdExpression $ Left $ GlobalIdentifier s i
  convert (OptQualified ms (Just nns), i) = DeclaratorId_IdExpression Nothing $ IdExpression $ Left $ NestedUnqualifiedId ms nns Nothing $ convert i
instance Convert QualifiedId DeclaratorId where
  convert = DeclaratorId_IdExpression Nothing . IdExpression . Left
instance Convert (OptQualified, SimpleTemplateId) DeclaratorId where
  convert (OptQualified Nothing Nothing, stid) = convert stid
  convert (OptQualified (Just s) Nothing, stid) = DeclaratorId_IdExpression Nothing $ IdExpression $ Left $ GlobalTemplateId s $ convert stid
  convert (OptQualified ms (Just nns), stid) = DeclaratorId_IdExpression Nothing $ IdExpression $ Left $ NestedUnqualifiedId ms nns Nothing $ convert stid
instance Convert ElaboratedTypeSpecifier DeclaratorId where
  convert (ElaboratedTypeSpecifier _ optqualified (Right identifier)) = convert (optqualified, identifier)
  convert (ElaboratedTypeSpecifier _ optqualified (Left (_, stid))) = convert (optqualified, stid)
    -- Todo: Maybe using the (KwdTemplate, White) pair in the declarator-id would be better.
instance Convert Declarator DeclaratorId where
  convert (Declarator_PtrDeclarator p) = convert p
  convert (Declarator_TrailingReturnType d _ _) = convert d
instance Convert PtrDeclarator DeclaratorId where
  convert (PtrDeclarator_NoptrDeclarator d) = convert d
  convert (PtrDeclarator _ d) = convert d
instance Convert NoptrDeclarator DeclaratorId where
  convert (NoptrDeclarator_Id did) = did
  convert (NoptrDeclarator_WithParams d _) = convert d
  convert (NoptrDeclarator_Squared d _) = convert d
  convert (NoptrDeclarator_Parenthesized (Parenthesized _ (Enclosed d) _)) = convert d
instance Convert ((ScopeRes, White), UnqualifiedId) (Maybe DeclaratorId) where
  convert (scoperes, UnqualifiedId_Identifier i) = Just $ convert (GlobalIdentifier scoperes i)
  convert (scoperes, UnqualifiedId_TemplateId i) = Just $ convert (GlobalTemplateId scoperes i)
  convert (scoperes, UnqualifiedId_OperatorFunctionId i) = Just $ convert (GlobalOperatorFunctionId scoperes i)
  convert (_, UnqualifiedId_Destructor _ _) = Nothing -- There are no global destructors.
  convert (_, UnqualifiedId_ConversionFunctionId _) = Nothing -- There are no global conversion operators.
instance Convert UsingDeclaration (Maybe DeclaratorId) where
  convert (UsingDeclaration_Nested _ _ msr nns i _) = Just $ convert $ NestedUnqualifiedId msr nns Nothing i
  convert (UsingDeclaration_NonNested _ s i _) = convert (s, i)

-- Finding declarations

gfoldl_with_lengths :: Data a ⇒ Int → (forall d. Data d ⇒ Int → d → [r]) → a → [r]
gfoldl_with_lengths i f = runIdentity . gfoldl_with_lengthsM i ((Identity .) . f)

gfoldl_with_ranges :: Data a ⇒ Int → (forall d. Data d ⇒ Range Char → d → [r]) → a → [r]
gfoldl_with_ranges i f = runIdentity . gfoldl_with_rangesM i ((Identity .) . f)

gfoldl_with_lengthsM :: (Data a, Monad m) ⇒ Int → (forall d. Data d ⇒ Int → d → m [r]) → a → m [r]
gfoldl_with_lengthsM i f = gfoldl_with_rangesM i (f . pos . start)

data GfoldlWithLengthsIntermediary m r a = GfoldlWithLengthsIntermediary { gwli_result :: m [r], _off :: Int }

gfoldl_with_rangesM :: (Data a, Monad m) ⇒ Int → (forall d. Data d ⇒ Range Char → d → m [r]) → a → m [r]
gfoldl_with_rangesM i f = gwli_result . gfoldl (\(GfoldlWithLengthsIntermediary m o) y →
  let n = length (Cxx.Show.show_simple y) in
  GfoldlWithLengthsIntermediary (liftM2 (++) m (f (Range (Pos o) n) y)) (o + n)) (\_ → GfoldlWithLengthsIntermediary (return []) i)

listElem :: forall a d . (Data a, Typeable a, Data d) ⇒ Phantom a → d → Maybe (Range Char, Range Char)
listElem _ d
  | Just (Commad x []) ← cast d :: Maybe (Commad a) =
    Just $ diag $ fullRange (Cxx.Show.show_simple x)
  | Just (Commad x ((cw, _):_)) ← cast d :: Maybe (Commad a) =
    Just (fullRange $ Cxx.Show.show_simple (x, cw), fullRange $ Cxx.Show.show_simple x)
  | Just x@(cw, r) ← cast d :: Maybe ((CommaOp, White), a) =
    Just (fullRange $ Cxx.Show.show_simple x,
      Range (Pos $ length $ Cxx.Show.show_simple cw) (length $ Cxx.Show.show_simple r))
  | otherwise = Nothing

bodyOf :: Data d ⇒ d → DeclaratorId → Maybe (Range Char)
bodyOf x did
  | Just (GeordiRequest_Block (FunctionBody _ (CompoundStatement (Curlied o b _))) _) ← cast x, strip (show did) == "main" =
    Just $ Range (Pos $ length $ Cxx.Show.show_simple o) (length $ Cxx.Show.show_simple b)
  | Just (ClassSpecifier classHead (Curlied o b _)) ← cast x, convert classHead == Just did =
    Just $ Range (Pos $ length $ Cxx.Show.show_simple (classHead, o)) (length $ Cxx.Show.show_simple b)
  | Just (EnumSpecifier enumHead (Curlied o b _)) ← cast x, convert enumHead == Just did =
    Just $ Range (Pos $ length $ Cxx.Show.show_simple (enumHead, o)) (length $ Cxx.Show.show_simple b)
  | Just (FunctionDefinition specs declarator (FunctionBody ctorInitializer (CompoundStatement (Curlied o b _)))) ← cast x, convert declarator == did =
    Just $ Range (Pos $ length $ Cxx.Show.show_simple (specs, declarator, ctorInitializer, o)) (length $ Cxx.Show.show_simple b)
  | Just (NamespaceDefinition inline kwd (Just identifier) (Curlied o b _)) ← cast x, convert identifier == did =
    Just $ Range (Pos $ length $ Cxx.Show.show_simple (inline, kwd, identifier, o)) (length $ Cxx.Show.show_simple b)
  | otherwise = Nothing

instance Eq DataType where (==) = (==) `on` dataTypeName

constr_eq :: Constr → Constr → Bool
  -- The existing Eq instance only compares constructor indices for algebraic data types, so for instance the first constructors of two unrelated algebraic data types are considered equal.
constr_eq c d = c == d ∧ constrType c == constrType d

data AnyData = forall d . Data d ⇒ AnyData d

type TreePath = NeList AnyData

applyAny :: (forall a. Data a ⇒ a → b) → (AnyData → b)
applyAny p (AnyData x) = p x

diag :: a → (a, a)
diag x = (x, x)

finder :: Findable → TreePath → Maybe (Range Char, Range Char)
finder f = case f of
  FindableDataType t → (diag .) . simpleFinder ((== t) . applyAny dataTypeOf . NeList.head)
  FindableConstr c → (diag .) . simpleFinder (constr_eq c . applyAny toConstr . NeList.head)
  BodyOf d → (diag .) . applyAny (`bodyOf` d) . NeList.head
  DeclarationOf d → (diag .) . simpleFinder (complete (`isDeclarationOf` d))
  Constructor → (diag .) . simpleFinder  (complete $ isSpecialFuncWith isConstructorId)
  Destructor → (diag .) . simpleFinder (complete $ isSpecialFuncWith isDestructorId)
  ConversionFunction → (diag .) . simpleFinder (complete $ isSpecialFuncWith isConversionFunctionId)
  FindableParameterDeclaration → applyAny (listElem (Phantom :: Phantom ParameterDeclaration)) . NeList.head
  TemplateParameter → applyAny (listElem (Phantom :: Phantom TemplateParameter)) . NeList.head
  TemplateArgument → applyAny (listElem (Phantom :: Phantom TemplateArgument)) . NeList.head
 where
  simpleFinder p t | AnyData x ← NeList.head t =
    if p t then Just $ fullRange $ Cxx.Show.show_simple x else Nothing

find :: Data d ⇒ Findable → d → [(Range Char, Range Char)]
find f = findRange (finder f) [] 0

complete :: (forall d . Data d ⇒ d → Bool) → TreePath → Bool
complete p d | AnyData x ← NeList.head d =
  p x ∧ case NeList.tail d of [] → True; AnyData h : _ → not $ p h

pathTo :: Data d ⇒ d → Range Char → Int → TreePath
  -- Precondition: the range is entirely within [0, length (show d)]
pathTo x r i = AnyData x :| case gfoldl_with_ranges i f x of
  [] → []
  l : _ → toList l
  where f r'@(Range st _) y = [pathTo y r (pos st) | r `contained_in` r']

findable_productions, all_productions :: [DataType]
findable_productions =
#define P(n) dataTypeOf (undefined :: Cxx.Basics.n)
    -- A.1 Keywords [gram.key]
    [ P(TypedefName), P(NamespaceName), P(OriginalNamespaceName), P(NamespaceAlias)
    , P(ClassName), P(EnumName), P(TemplateName)

    -- A.2 Lexical conventions [gram.lex]
    , P(Identifier), P(Literal), P(IntegerLiteral), P(CharacterLiteral), P(FloatingLiteral), P(StringLiteral), P(EncodingPrefix)

    -- A.4 Expressions [gram.expr]
    , P(PrimaryExpression), P(IdExpression), P(UnqualifiedId), P(QualifiedId), P(NestedNameSpecifier), P(PostfixExpression)
    , P(ExpressionList), P(PseudoDestructorName), P(UnaryExpression), P(UnaryOperator), P(NewExpression), P(NewPlacement)
    , P(NewTypeId), P(NewDeclarator), P(NoptrNewDeclarator), P(NewInitializer), P(DeleteExpression)
    , P(CastExpression), P(PmExpression), P(MultiplicativeExpression), P(AdditiveExpression), P(ShiftExpression)
    , P(RelationalExpression), P(EqualityExpression), P(AndExpression), P(ExclusiveOrExpression)
    , P(InclusiveOrExpression), P(LogicalAndExpression), P(LogicalOrExpression), P(ConditionalExpression)
    , P(AssignmentExpression), P(AssignmentOperator), P(Expression), P(ConstantExpression)
    , P(LambdaExpression), P(LambdaIntroducer), P(LambdaCapture), P(CaptureDefault), P(CaptureList), P(Capture), P(LambdaDeclarator)

    -- A.5 Statements [gram.stmt]
    , P(Statement), P(StatementSeq), P(Label), P(LabeledStatement), P(ExpressionStatement), P(CompoundStatement)
    , P(SelectionStatement), P(Condition), P(IterationStatement), P(ForInitStatement), P(ForRangeDeclaration), P(ForRangeInitializer), P(JumpStatement), P(DeclarationStatement)

    -- A.6 Declarations [gram.dcl]
    , P(Declaration), P(DeclarationSeq), P(BlockDeclaration), P(AliasDeclaration), P(SimpleDeclaration), P(StaticAssertDeclaration)
    , P(DeclSpecifier), P(DeclSpecifierSeq), P(StorageClassSpecifier), P(FunctionSpecifier), P(TrailingTypeSpecifier), P(TypeSpecifier), P(TypeSpecifierSeq), P(SimpleTypeSpecifier)
    , P(TypeName), P(ElaboratedTypeSpecifier), P(EnumSpecifier), P(EnumHead), P(EnumKey), P(EnumeratorList), P(EnumeratorDefinition)
    , P(Enumerator), P(NamespaceDefinition), P(NamespaceAliasDefinition), P(UsingDeclaration), P(UsingDirective), P(AsmDefinition), P(LinkageSpecification)
    , P(AlignmentSpecifier)

    -- A.7 Declarators [gram.decl]
    , P(InitDeclaratorList), P(InitDeclarator), P(Declarator), P(PtrDeclarator), P(NoptrDeclarator), P(ParametersAndQualifiers)
    , P(PtrOperator), P(CvQualifier), P(CvQualifierSeq), P(DeclaratorId), P(TypeId), P(AbstractDeclarator), P(PtrAbstractDeclarator)
    , P(NoptrAbstractDeclarator), P(ParameterDeclarationClause), P(ParameterDeclarationList), P(FunctionDefinition)
    , P(FunctionBody), P(Initializer), P(BraceOrEqualInitializer), P(InitializerClause), P(InitializerList), P(BracedInitList), P(NamespaceBody)
    , P(TrailingReturnType)

    -- A.8 Classes [gram.class]
    , P(ClassSpecifier), P(ClassHead), P(ClassKey), P(MemberAccessSpecifier)
    , P(MemberSpecification), P(MemberDeclaration), P(MemberDeclaratorList), P(MemberDeclarator), P(PureSpecifier)

    -- A.9 Derived classes [gram.derived]
    , P(BaseClause), P(BaseSpecifierList), P(BaseSpecifier), P(AccessSpecifier)

    -- A.10 Special member functions [gram.special]
    , P(ConversionFunctionId), P(ConversionTypeId), P(CtorInitializer), P(MemInitializerList), P(MemInitializer), P(MemInitializerId)

    -- A.11 Overloading [gram.over]
    , P(OperatorFunctionId)

    -- A.12 Templates [gram.temp]
    , P(TemplateDeclaration), P(TemplateParameterList), P(TypeParameter), P(TemplateArguments), P(SimpleTemplateId)
    , P(TemplateId), P(TemplateArgumentList), P(TemplateArgument), P(TypenameSpecifier), P(ExplicitInstantiation)
    , P(ExplicitSpecialization)

    -- A.13 Exception handling [gram.except]
    , P(TryBlock), P(FunctionTryBlock), P(Handler), P(HandlerSeq), P(ExceptionDeclaration), P(ThrowExpression), P(ExceptionSpecification)
    , P(TypeIdList) ]
all_productions = findable_productions ++ [P(ParameterDeclaration), P(TemplateParameter), P(TemplateArgument)]
  -- These three are not part of findable_productions because they get special Findable treatment.
#undef P

namedPathTo :: Data d ⇒ d → Range Char → [String]
namedPathTo d r = map Cxx.Show.dataType_abbreviated_productionName $
  filter (∈ all_productions) $ toList $ fmap (applyAny dataTypeOf) (pathTo d r 0)

findRange :: (Offsettable a, Data d) ⇒ (TreePath → Maybe a) → [AnyData] → Int → d → [a]
findRange p tp i x = Maybe.maybeToList (offset i . p (AnyData x :| tp)) ++ gfoldl_with_lengths i (findRange p (AnyData x : tp)) x

make_edits :: (MyMonadError String m, Data d) ⇒ Range Char → MakeDeclaration → Int → d → m [TextEdit Char]
make_edits r m i d = do
  ot ← gfoldl_with_lengthsM i (make_edits r m) d
  oi ← (if Range (Pos i) (length $ strip $ Cxx.Show.show_simple d) == r
    then (case apply_makedecl_to m d of
      MaybeEitherString (Just (Right d')) → return $ offset i $ diff_as_Edits (Cxx.Show.show_simple d) (Cxx.Show.show_simple d')
      MaybeEitherString (Just (Left e)) → throwError e
      MaybeEitherString Nothing → return [])
    else return [])
  return $ oi ++ ot

instance Convert [DeclSpecifier] [TypeSpecifier] where
  convert = Maybe.mapMaybe $ \ds →
    case ds of
      DeclSpecifier_TypeSpecifier t → Just t
      _ → Nothing

isSpecialFunc :: Data d ⇒ d → Maybe DeclaratorId
  -- "special" meaning: without any type-specifiers.
isSpecialFunc x
  | Just s@(MemberDeclaration l _ _) ← cast x, null (convert l :: [TypeSpecifier]) = convert s
  | Just (MemberFunctionDefinition f@(FunctionDefinition Nothing _ _) _) ← cast x = Just $ convert f
  | Just (MemberTemplateDeclaration d) ← cast x = isSpecialFunc d
  | Just f@(FunctionDefinition l _ _) ← cast x, null (convert l :: [TypeSpecifier]) = Just $ convert f
  | Just (TemplateDeclaration _ _ _ d) ← cast x = isSpecialFunc d
  | Just (Declaration_FunctionDefinition d) ← cast x = isSpecialFunc d
  | Just (Declaration_TemplateDeclaration d) ← cast x = isSpecialFunc d
  | Just (Declaration_BlockDeclaration d) ← cast x = isSpecialFunc d
  | Just (BlockDeclaration_SimpleDeclaration d) ← cast x = isSpecialFunc d
  | Just s@(SimpleDeclaration l _ _) ← cast x, null (convert l :: [TypeSpecifier]) = convert s
  | otherwise = Nothing

isSpecialFuncWith :: Data d ⇒ (DeclaratorId → Bool) → d → Bool
isSpecialFuncWith p x
  | Just did ← isSpecialFunc x = p did
  | otherwise = False

isConstructorId :: DeclaratorId → Bool
isConstructorId i = not $ isDestructorId i ∨ isConversionFunctionId i

isDestructorId :: DeclaratorId → Bool
isDestructorId (DeclaratorId_IdExpression Nothing (IdExpression e)) = case e of
  Right (UnqualifiedId_Destructor _ _) → True
  Left (NestedUnqualifiedId _ _ _ (UnqualifiedId_Destructor _ _)) → True
  _ → False
isDestructorId _ = False

isConversionFunctionId :: DeclaratorId → Bool
isConversionFunctionId = Maybe.isJust . (convert :: DeclaratorId → Maybe ConversionFunctionId)

isDeclarationOf :: Data d ⇒ d → DeclaratorId → Bool
isDeclarationOf x did = Just did == case () of { ()
  | Just s ← cast x → convert (s :: Declaration)
  | Just s ← cast x → convert (s :: BlockDeclaration)
  | Just s ← cast x → Just $ convert (s :: FunctionDefinition)
  | Just s ← cast x → convert (s :: TemplateDeclaration)
  | Just s ← cast x → convert (s :: ExplicitInstantiation)
  | Just s ← cast x → convert (s :: ExplicitSpecialization)
  | Just s ← cast x → convert (s :: NamespaceDefinition)
  | Just s ← cast x → convert (s :: SimpleDeclaration)
  | Just s ← cast x → Just $ convert (s :: NamespaceAliasDefinition)
  | Just s ← cast x → convert (s :: UsingDeclaration)
  | Just s ← cast x → Just $ convert (s :: AliasDeclaration)
  | Just s ← cast x → convert (s :: MemberDeclaration)
  | Just s ← cast x → convert (s :: ExceptionDeclaration)
  | Just s ← cast x → convert (s :: ParameterDeclaration)
  | Just s ← cast x → convert (s :: Condition)
  | Just s ← cast x → Just $ convert (s :: ForRangeDeclaration)
  | otherwise → Nothing }

-- Specifier/qualifier compatibility.

class Compatible a b where compatible :: a → b → Bool
  -- For instances where a=b, compatible should be symmetric.

instance Compatible CvQualifier CvQualifier where compatible = (≠)

instance Compatible CvQualifier TypeSpecifier where
  compatible cv (TypeSpecifier_TrailingTypeSpecifier (TrailingTypeSpecifier_CvQualifier (cv', _))) = compatible cv cv'
  compatible _ _ = True

instance Compatible CvQualifier DeclSpecifier where
  compatible cv (DeclSpecifier_TypeSpecifier t) = compatible cv t
  compatible _ _ = True

instance Compatible SimpleTypeSpecifier SimpleTypeSpecifier where
  compatible (SignSpec _) (LengthSpec _) = True
  compatible (LengthSpec _) (SignSpec _) = True
  compatible (LengthSpec (LongSpec, _)) (SimpleTypeSpecifier_BasicType (Int', _)) = True
  compatible (LengthSpec (LongSpec, _)) (SimpleTypeSpecifier_BasicType (Double', _)) = True
  compatible x@(SimpleTypeSpecifier_BasicType _) y@(LengthSpec _) = compatible y x
  compatible (SignSpec _) (SimpleTypeSpecifier_BasicType (Int', _)) = True
  compatible (SimpleTypeSpecifier_BasicType (Int', _)) (SignSpec _) = True
  compatible _ _ = False

instance Compatible TrailingTypeSpecifier TrailingTypeSpecifier where
  compatible (TrailingTypeSpecifier_CvQualifier (cv, _)) (TrailingTypeSpecifier_CvQualifier (cv', _)) = compatible cv cv'
  compatible (TrailingTypeSpecifier_CvQualifier _) _ = True
  compatible _ (TrailingTypeSpecifier_CvQualifier _) = True
  compatible (TrailingTypeSpecifier_SimpleTypeSpecifier x) (TrailingTypeSpecifier_SimpleTypeSpecifier y) = compatible x y
  compatible _ _ = False

instance Compatible TypeSpecifier TypeSpecifier where
  compatible (TypeSpecifier_TrailingTypeSpecifier x) (TypeSpecifier_TrailingTypeSpecifier y) = compatible x y
  compatible _ _ = False

instance Compatible MakeSpecifier MakeSpecifier where
  compatible (MakeSpecifier_DeclSpecifier d) (MakeSpecifier_DeclSpecifier d') = compatible d d'
  compatible x@(MakeSpecifier_DeclSpecifier _) y = compatible y x
  compatible (NonStorageClassSpecifier scs) (MakeSpecifier_DeclSpecifier (DeclSpecifier_StorageClassSpecifier (scs', _))) = scs ≠ scs'
  compatible _ _ = True

instance Compatible DeclSpecifier DeclSpecifier where
  compatible (DeclSpecifier_TypeSpecifier x) (DeclSpecifier_TypeSpecifier y) = compatible x y
  compatible (DeclSpecifier_StorageClassSpecifier _) (DeclSpecifier_StorageClassSpecifier _) = False
  compatible (DeclSpecifier_FunctionSpecifier (s, _)) (DeclSpecifier_FunctionSpecifier (s', _)) | s == s' = False
  compatible (DeclSpecifier_Typedef _) (DeclSpecifier_Typedef _) = False
  compatible (DeclSpecifier_ConstExpr _) (DeclSpecifier_ConstExpr _) = False
  compatible (DeclSpecifier_AlignmentSpecifier _) (DeclSpecifier_AlignmentSpecifier _) = False
  compatible (DeclSpecifier_FunctionSpecifier (Virtual, _)) (DeclSpecifier_StorageClassSpecifier (Static, _)) = False
  compatible (DeclSpecifier_StorageClassSpecifier (Static, _)) (DeclSpecifier_FunctionSpecifier (Virtual, _)) = False
  compatible _ _ = True

-- Making sure things end with whitespace.

data WithAlternate a = WithoutAlternate a | WithAlternate { _wa_primary :: a, _wa_alternate :: a } deriving Typeable

instance Functor WithAlternate where
  fmap f (WithoutAlternate x) = WithoutAlternate $ f x
  fmap f (WithAlternate x y) = WithAlternate (f x) (f y)

with_trailing_white :: Data d ⇒ d → d
with_trailing_white = \x → case f x of WithoutAlternate y → y; WithAlternate _ y → y
  where
    f :: Data d ⇒ d → WithAlternate d
    f | Just h ← cast (\w@(White s) → WithAlternate w (White $ if null s then " " else s)) = h
      | otherwise = gfoldl (\e d → case e of
        (WithAlternate h i) → case f d of
          WithoutAlternate x → WithAlternate (h x) (i x)
          WithAlternate x y → WithAlternate (h x) (h y)
        (WithoutAlternate h) → h . f d) WithoutAlternate

-- Specifier/qualifier conversion

instance Convert TrailingTypeSpecifier TypeSpecifier where convert = TypeSpecifier_TrailingTypeSpecifier
instance Convert (BasicType, White) TypeSpecifier where convert = convert . TrailingTypeSpecifier_SimpleTypeSpecifier . SimpleTypeSpecifier_BasicType
instance Convert (BasicType, White) DeclSpecifier where convert = (convert :: TypeSpecifier → DeclSpecifier) . convert
instance Convert CvQualifier TrailingTypeSpecifier where convert cvq = TrailingTypeSpecifier_CvQualifier (cvq, White " ")
instance Convert CvQualifier TypeSpecifier where convert = convert . (convert :: CvQualifier → TrailingTypeSpecifier)
instance Convert CvQualifier DeclSpecifier where convert = convert . (convert :: CvQualifier → TypeSpecifier)
instance Convert CvQualifier MakeSpecifier where convert = convert . (convert :: TypeSpecifier → DeclSpecifier) . convert
instance Convert SimpleTypeSpecifier (Maybe Sign) where convert (SignSpec (s, _)) = Just s; convert _ = Nothing
instance Convert SimpleTypeSpecifier (Maybe LengthSpec) where convert (LengthSpec (s, _)) = Just s; convert _ = Nothing
instance Convert SimpleTypeSpecifier TypeSpecifier where convert = convert . TrailingTypeSpecifier_SimpleTypeSpecifier
instance Convert TypeSpecifier DeclSpecifier where convert = DeclSpecifier_TypeSpecifier
instance Convert TypeSpecifier (Maybe Sign) where convert x = convert x >>= (convert :: SimpleTypeSpecifier → Maybe Sign)
instance Convert TypeSpecifier (Maybe SimpleTypeSpecifier) where convert (TypeSpecifier_TrailingTypeSpecifier (TrailingTypeSpecifier_SimpleTypeSpecifier s)) = Just s; convert _ = Nothing
instance Convert TypeSpecifier (Maybe LengthSpec) where convert x = convert x >>= (convert :: SimpleTypeSpecifier → Maybe LengthSpec)
instance Convert TypeSpecifier (Maybe (CvQualifier, White)) where convert (TypeSpecifier_TrailingTypeSpecifier (TrailingTypeSpecifier_CvQualifier cvq)) = Just cvq; convert _ = Nothing
instance Convert TypeSpecifier (Maybe CvQualifier) where convert x = fst . (convert x :: Maybe (CvQualifier, White))
instance Convert DeclSpecifier (Maybe TypeSpecifier) where convert (DeclSpecifier_TypeSpecifier s) = Just s; convert _ = Nothing
instance Convert DeclSpecifier (Maybe StorageClassSpecifier) where convert (DeclSpecifier_StorageClassSpecifier (s, _)) = Just s; convert _ = Nothing
instance Convert DeclSpecifier (Maybe FunctionSpecifier) where convert (DeclSpecifier_FunctionSpecifier (s, _)) = Just s; convert _ = Nothing
instance Convert DeclSpecifier MakeSpecifier where convert = MakeSpecifier_DeclSpecifier
instance Convert DeclSpecifier (Maybe Sign) where convert x = convert x >>= (convert :: TypeSpecifier → Maybe Sign)
instance Convert DeclSpecifier (Maybe LengthSpec) where convert x = convert x >>= (convert :: TypeSpecifier → Maybe LengthSpec)
instance Convert DeclSpecifier (Maybe (CvQualifier, White)) where convert (DeclSpecifier_TypeSpecifier t) = convert t; convert _ = Nothing
instance Convert DeclSpecifier (Maybe CvQualifier) where convert x = fst . (convert x :: Maybe (CvQualifier, White))
instance Convert MakeSpecifier (Maybe (CvQualifier, White)) where convert (MakeSpecifier_DeclSpecifier t) = convert t; convert _ = Nothing
instance Convert LengthSpec SimpleTypeSpecifier where convert x = LengthSpec (x, White " ")
instance Convert LengthSpec TypeSpecifier where convert = convert . (convert :: LengthSpec → SimpleTypeSpecifier)
instance Convert LengthSpec DeclSpecifier where convert = convert . (convert :: LengthSpec → TypeSpecifier)
instance Convert LengthSpec MakeSpecifier where convert = convert . (convert :: LengthSpec → DeclSpecifier)

-- Misc conversions

instance Convert PtrDeclarator Declarator where convert = Declarator_PtrDeclarator
instance Convert NoptrDeclarator PtrDeclarator where convert = PtrDeclarator_NoptrDeclarator
instance Convert NoptrDeclarator Declarator where convert = convert . (convert :: NoptrDeclarator → PtrDeclarator)
instance Convert NoptrDeclarator InitDeclarator where convert = flip InitDeclarator Nothing . convert

instance Convert DeclaratorId (Maybe ConversionFunctionId) where
  convert (DeclaratorId_IdExpression Nothing (IdExpression e)) =
    case e of
      Left (NestedUnqualifiedId _ _ _ (UnqualifiedId_ConversionFunctionId i)) → Just i
      Right (UnqualifiedId_ConversionFunctionId i) → Just i
      _ → Nothing
  convert _ = Nothing

-- Declaration splitting

class SplitDecls a where split_decls :: a → NeList a

instance SplitDecls Declaration where
  split_decls (Declaration_BlockDeclaration bd) = fmap Declaration_BlockDeclaration $ split_decls bd
  split_decls d = return d

instance SplitDecls BlockDeclaration where
  split_decls (BlockDeclaration_SimpleDeclaration sd) = fmap BlockDeclaration_SimpleDeclaration $ split_decls sd
  split_decls d = return d

instance SplitDecls SimpleDeclaration where
  split_decls d@(SimpleDeclaration _ Nothing _) = return d
  split_decls (SimpleDeclaration specs (Just (InitDeclaratorList (Commad x l))) w) =
    (\y → SimpleDeclaration specs (Just (InitDeclaratorList (Commad y []))) w) . (x :| (snd . l))

instance SplitDecls Statement where
  split_decls (Statement_DeclarationStatement (DeclarationStatement d)) =
    Statement_DeclarationStatement . DeclarationStatement . split_decls d
  split_decls (Statement_CompoundStatement (CompoundStatement (Curlied x (Enclosed (Just (StatementSeq l))) y))) =
    return (Statement_CompoundStatement $ CompoundStatement $ Curlied x (Enclosed $ Just $ StatementSeq $ l >>= split_decls) y)
  split_decls (Statement_SelectionStatement (IfStatement k c s Nothing)) =
    return (Statement_SelectionStatement $ IfStatement k c (compound_split_decls s) Nothing) -- todo: do else part as well
    -- todo: do while and do-loops as well.
  split_decls s = return $ gmapT split_all_decls s

instance SplitDecls MemberDeclaration where
  split_decls (MemberDeclaration specs (Just (MemberDeclaratorList (Commad d ds))) s) =
    (\d' → MemberDeclaration specs (Just (MemberDeclaratorList (Commad d' []))) s) . (d :| (snd . ds))
  split_decls d = return $ gmapT split_all_decls d

compound_split_decls :: Statement → Statement
compound_split_decls s
  | null (NeList.tail l) = NeList.head l
  | otherwise = Statement_CompoundStatement $ CompoundStatement $ Curlied (OpenCurly_, White "") (Enclosed $ Just $ StatementSeq l) (CloseCurly_, White "")
  where l = split_decls s

split_all_decls :: Data a ⇒ a → a
split_all_decls = everywhere $ Maybe.fromMaybe id $ Maybe.listToMaybe . Maybe.catMaybes $
  [ cast ((>>= split_decls) :: NeList Declaration → NeList Declaration)
  , cast ((>>= split_decls) :: NeList Statement → NeList Statement)
  , cast (compound_split_decls :: Statement → Statement)
  , cast (concatMap (either (map Left . toList . split_decls) ((:[]) . Right)) :: [Either MemberDeclaration MemberAccessSpecifier] → [Either MemberDeclaration MemberAccessSpecifier])
  ]

-- Qualifier/specifier classification

is_primary_TrailingTypeSpecifier :: TrailingTypeSpecifier → Bool
is_primary_TrailingTypeSpecifier (TrailingTypeSpecifier_CvQualifier _) = False
is_primary_TrailingTypeSpecifier _ = True

is_primary_TypeSpecifier :: TypeSpecifier → Bool
is_primary_TypeSpecifier (TypeSpecifier_TrailingTypeSpecifier t) = is_primary_TrailingTypeSpecifier t
is_primary_TypeSpecifier _ = True

is_primary_DeclSpecifier :: DeclSpecifier → Bool
is_primary_DeclSpecifier (DeclSpecifier_TypeSpecifier t) = is_primary_TypeSpecifier t
is_primary_DeclSpecifier _ = False

is_primary_MakeSpecifier :: MakeSpecifier → Bool
is_primary_MakeSpecifier (MakeSpecifier_DeclSpecifier t) = is_primary_DeclSpecifier t
is_primary_MakeSpecifier _ = False

instance Apply a b b ⇒ Apply [a] b b where apply = flip $ foldl $ flip apply
instance Apply a b c ⇒ Apply a (Enclosed b) (Enclosed c) where apply x (Enclosed y) = Enclosed $ apply x y
instance MaybeApply a b ⇒ MaybeApply a (Enclosed b) where mapply x (Enclosed y) = Enclosed . mapply x y

-- Id application

instance Apply DeclaratorId PtrAbstractDeclarator PtrDeclarator where
  apply i (PtrAbstractDeclarator_NoptrAbstractDeclarator npad) = PtrDeclarator_NoptrDeclarator $ apply i npad
  apply i (PtrAbstractDeclarator o Nothing) = PtrDeclarator (with_trailing_white o) $ PtrDeclarator_NoptrDeclarator $ NoptrDeclarator_Id i
  apply i (PtrAbstractDeclarator o (Just pad)) = let pd = apply i pad in PtrDeclarator (case Cxx.Show.show_simple pd of
    (h:_) | not (isIdChar h) → o; _ → with_trailing_white o) pd

instance Apply DeclaratorId NoptrAbstractDeclarator NoptrDeclarator where
  apply i (NoptrAbstractDeclarator Nothing (Right s)) = NoptrDeclarator_Squared (NoptrDeclarator_Id i) s
  apply i (NoptrAbstractDeclarator (Just npad) (Right s)) = NoptrDeclarator_Squared (apply i npad) s
  apply i (NoptrAbstractDeclarator Nothing (Left params)) = NoptrDeclarator_WithParams (NoptrDeclarator_Id i) params
  apply i (NoptrAbstractDeclarator (Just npad) (Left params)) = NoptrDeclarator_WithParams (apply i npad) params
  apply i (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w (Enclosed pad) w')) =
    NoptrDeclarator_Parenthesized $ Parenthesized w (Enclosed $ apply i pad) w'

-- TypeSpecifier application

-- Here and elsewhere, we always keep specifiers in the order they appeared in the source text as much as possible.

instance Apply TypeSpecifier (NeList TypeSpecifier) (NeList TypeSpecifier) where
  apply d = (with_trailing_white d :|) . filter (compatible d) . toList

-- DeclSpecifier application

instance Apply DeclSpecifier [DeclSpecifier] [DeclSpecifier] where
  apply d = (with_trailing_white d :) . filter (compatible d)

instance Apply DeclSpecifier (NeList DeclSpecifier) (NeList DeclSpecifier) where
  apply d = (with_trailing_white d :|) . filter (compatible d) . toList

instance Apply [DeclSpecifier] (NeList DeclSpecifier) (NeList DeclSpecifier) where
  apply [] l = l
  apply l@(h:t) x = h :| (with_trailing_white t ++ filter (\s → all (compatible s) l) (toList x))

instance MaybeApply DeclSpecifier (NeList TypeSpecifier) where
  mapply (DeclSpecifier_TypeSpecifier x) typespecs = return $ apply x typespecs
  mapply x _ = throwError $ "Invalid decl-specifier for type-specifier-seq: " ++ Cxx.Show.show_simple x

instance MaybeApply [DeclSpecifier] (NeList TypeSpecifier) where
  mapply = flip $ foldM $ flip mapply

-- MakeSpecifier application

type M = ([MakeSpecifier], Maybe PtrAbstractDeclarator)

instance MaybeApply M (DeclSpecifierSeq, Either Declarator (Maybe AbstractDeclarator)) where
  mapply x (l, Left d) | (l', d') ← apply x (l, d) = return (l', Left d')
  mapply x (DeclSpecifierSeq l, Right Nothing) = return $
    first DeclSpecifierSeq $ second (Right . (AbstractDeclarator_PtrAbstractDeclarator .)) $
      apply x (l, Nothing :: Maybe PtrAbstractDeclarator)
  mapply x (DeclSpecifierSeq l, Right (Just (AbstractDeclarator_PtrAbstractDeclarator d))) = return $
    first DeclSpecifierSeq $ second (Right . (AbstractDeclarator_PtrAbstractDeclarator .)) $ apply x (l, Just d)
  mapply _ (_, Right (Just (AbstractDeclarator_Ellipsis _))) = throwError "Sorry, make-application to abstract-declarator with ellipsis not yet implemented."

instance MaybeApply M (TypeSpecifierSeq, Declarator) where
  mapply x (l, Declarator_PtrDeclarator d) = second Declarator_PtrDeclarator . mapply x (l, d)
  mapply _ _ = throwError "Sorry, not yet implemented."

instance Apply M (Maybe DeclSpecifierSeq, Declarator) (Maybe DeclSpecifierSeq, Declarator) where
  apply x (y, Declarator_PtrDeclarator d) = second Declarator_PtrDeclarator $ apply x (y, d)
  apply _ y = y -- Sorry, not yet implemented.

instance Apply M (NeList DeclSpecifier, Declarator) (NeList DeclSpecifier, Declarator) where
  apply x (l, Declarator_PtrDeclarator d) = second Declarator_PtrDeclarator $ apply x (l, d)
  apply _ y = y -- Sorry, not yet implemented.

instance Apply M (DeclSpecifierSeq, Declarator) (DeclSpecifierSeq, Declarator) where
  apply x (DeclSpecifierSeq l, d)= first DeclSpecifierSeq $ apply x (l, d)

instance Apply M (Maybe DeclSpecifierSeq, PtrDeclarator) (Maybe DeclSpecifierSeq, PtrDeclarator) where
  apply x (m, d) = first convert $ apply x (convert m :: [DeclSpecifier], d)

instance (Apply [MakeSpecifier] (l DeclSpecifier) (l DeclSpecifier), Apply MakeSpecifier (l DeclSpecifier, PtrDeclarator) (l DeclSpecifier, PtrDeclarator)) ⇒ Apply M (l DeclSpecifier, PtrDeclarator) (l DeclSpecifier, PtrDeclarator) where
  apply (l, Nothing) (l', x) =
    if any is_primary_MakeSpecifier l
      then (apply l l', PtrDeclarator_NoptrDeclarator $ NoptrDeclarator_Id $ convert x)
      else foldl (flip apply) (l', x) l
  apply (l, Just pad) (l', x) = (apply l l', apply (convert x :: DeclaratorId) pad)

instance Apply M (NeList DeclSpecifier, Maybe PtrAbstractDeclarator) (NeList DeclSpecifier, Maybe PtrAbstractDeclarator) where
  apply (l, Nothing) (l', Just x) =
    if any is_primary_MakeSpecifier l
      then (apply l l', Just x)
      else second Just $ foldl (flip apply) (l', x) l
  apply (l, m) (l', Nothing) = (apply l l', m)
  apply (l, Just x) (l', _) = (apply l l', Just x)

instance MaybeApply M (TypeSpecifierSeq, PtrDeclarator)  where
  mapply (l, Nothing) (l', x) =
    if any is_primary_MakeSpecifier l
      then flip (,) (PtrDeclarator_NoptrDeclarator $ NoptrDeclarator_Id $ convert x) . mapply l l'
      else foldM (flip mapply) (l', x) l
  mapply (l, Just pad) (l', x) = flip (,) (apply (convert x :: DeclaratorId) pad) . mapply l l'

instance MaybeApply [MakeSpecifier] TypeSpecifierSeq where mapply l l' = foldM (flip mapply) l' l

instance Apply MakeSpecifier ([DeclSpecifier], PtrDeclarator) ([DeclSpecifier], PtrDeclarator) where
  apply s (x, y) = maybe (apply s x, y) ((,) x) (mapply s y)

instance Apply MakeSpecifier (NeList DeclSpecifier, PtrAbstractDeclarator) (NeList DeclSpecifier, PtrAbstractDeclarator) where
  apply s (x, y) = maybe (apply s x, y) ((,) x) (mapply s y)

instance MaybeApply MakeSpecifier (TypeSpecifierSeq, PtrDeclarator) where
  mapply s (x, y) = maybe (flip (,) y . mapply s x) (return . (,) x) (mapply s y)

instance MaybeApply MakeSpecifier PtrDeclarator where
  mapply s (PtrDeclarator_NoptrDeclarator d) = PtrDeclarator_NoptrDeclarator . mapply s d
  mapply s (PtrDeclarator o d) = maybe (flip PtrDeclarator d . mapply s o) (return . PtrDeclarator o) (mapply s d)

instance MaybeApply MakeSpecifier PtrAbstractDeclarator where
  mapply s (PtrAbstractDeclarator_NoptrAbstractDeclarator d) =
    PtrAbstractDeclarator_NoptrAbstractDeclarator . mapply s d
  mapply _ _ = throwError "Sorry, not yet implemented."

instance MaybeApply MakeSpecifier PtrOperator where
  mapply s (PtrOperator_Ptr o cvs) = PtrOperator_Ptr o . mapply s cvs
  mapply s (PtrOperator_Nested x y z cvs) = PtrOperator_Nested x y z . mapply s cvs
  mapply _ (PtrOperator_Ref _) = throwError "Cannot apply make-specifier to reference ptr-operator."

eraseCv :: CvQualifier → Maybe CvQualifierSeq → Maybe CvQualifierSeq
eraseCv _ Nothing = Nothing
eraseCv q (Just (CvQualifierSeq l)) = CvQualifierSeq . nonEmpty (neFilter ((≠ q) . fst) l)

instance MaybeApply MakeSpecifier (Maybe CvQualifierSeq) where
  mapply (MakeSpecifier_DeclSpecifier (DeclSpecifier_TypeSpecifier (TypeSpecifier_TrailingTypeSpecifier (TrailingTypeSpecifier_CvQualifier (cvq, _))))) =
    return . apply cvq
  mapply (NonCv cvq) = return . eraseCv cvq
  mapply _ = const $ throwError "Cannot apply non-cv make-specifier to cv-qualifier-seq."

instance MaybeApply MakeSpecifier NoptrAbstractDeclarator where
  mapply s (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w (Enclosed d) w')) = do
    d' ← mapply s d
    return (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w (Enclosed d') w'))
  mapply _ _ = throwError "Sorry, not yet implemented."

instance MaybeApply MakeSpecifier NoptrDeclarator where
  mapply _ (NoptrDeclarator_Id _) = throwError "Cannot apply make-specifier to declarator-id."
  mapply s (NoptrDeclarator_Parenthesized (Parenthesized w (Enclosed d) w')) = do
    d' ← mapply s d
    return (NoptrDeclarator_Parenthesized (Parenthesized w (Enclosed d') w'))
  mapply s (NoptrDeclarator_Squared d ce) = do
    d' ← mapply s d
    return $ NoptrDeclarator_Squared d' ce
  mapply s (NoptrDeclarator_WithParams d p) =
    case mapply s d of
      Just d' → return $ NoptrDeclarator_WithParams d' p
      Nothing → NoptrDeclarator_WithParams d . mapply s p

instance MaybeApply MakeSpecifier ParametersAndQualifiers where
  mapply (MakeSpecifier_DeclSpecifier (DeclSpecifier_TypeSpecifier (TypeSpecifier_TrailingTypeSpecifier (TrailingTypeSpecifier_CvQualifier (cvq, _))))) (ParametersAndQualifiers c cvqs m e) =
    return $ ParametersAndQualifiers c (apply cvq cvqs) m e
  mapply (NonCv cvq) (ParametersAndQualifiers c cvqs m e) =
    return $ ParametersAndQualifiers c (eraseCv cvq cvqs) m e
  mapply _ _ = throwError "Cannot apply non-cv make-specifier to parameters-and-qualifiers (yet)."

instance Apply MakeSpecifier (NeList DeclSpecifier, PtrDeclarator) (NeList DeclSpecifier, PtrDeclarator) where
  apply s (x, y) = maybe (apply s x, y) ((,) x) (mapply s y)

nonIntSpec :: (Eq s, Eq t, Convert t (Maybe s), Convert (BasicType, White) t) ⇒ s → NeList t → NeList t
nonIntSpec s l = case neFilter ((≠ Just s) . convert) l of
    l'@(h:t) | (convert (Int', White "") ∈ l') ∨ (convert (Double', White "") ∈ l') → h :| t
    l' → convert (Int', White " ") :| l'

instance MaybeApply MakeSpecifier (NeList TypeSpecifier) where
  mapply (MakeSpecifier_DeclSpecifier s) = mapply s
  mapply (NonStorageClassSpecifier _) = return
  mapply (NonFunctionSpecifier _) = return
  mapply (NonCv cvq) = return . filter_but_keep_nonempty ((≠ Just cvq) . convert)
  mapply (NonSign s) = return . nonIntSpec s
  mapply (NonLength s) = return . nonIntSpec s
  mapply LongLong = return . (convert LongSpec :|) . (convert LongSpec :) . filter (compatible (convert LongSpec :: TypeSpecifier)) . toList

instance MaybeApply MakeSpecifier TypeSpecifierSeq where
  mapply s (TypeSpecifierSeq l) = TypeSpecifierSeq . mapply s l

-- decl-specifier-seqs (which are always nonempty) always contain at least one primary specifier. Hence, removing, say, all cv-qualifiers, will always produce a proper (nonempty) decl-specifier-seq. However, the type system does not know that, and so we use the following ugly function:

filter_but_keep_nonempty :: forall a . (a → Bool) → NeList a → NeList a
filter_but_keep_nonempty p l = nonEmpty (filter p $ toList l) `orElse` return (NeList.head l)

instance Apply MakeSpecifier (NeList DeclSpecifier) (NeList DeclSpecifier) where
  apply (MakeSpecifier_DeclSpecifier s) = apply s
  apply (NonStorageClassSpecifier scs) = filter_but_keep_nonempty $ (≠ Just scs) . convert
  apply (NonFunctionSpecifier fs) = filter_but_keep_nonempty $ (≠ Just fs) . convert
  apply (NonCv cvq) = filter_but_keep_nonempty $ (≠ Just cvq) . convert
  apply (NonSign s) = nonIntSpec s
  apply (NonLength s) = nonIntSpec s
  apply LongLong = (convert LongSpec :|) . (convert LongSpec :) . filter (compatible (convert LongSpec :: DeclSpecifier)) . toList

instance Apply MakeSpecifier [DeclSpecifier] [DeclSpecifier] where
  apply (MakeSpecifier_DeclSpecifier d) = apply d
  apply (NonStorageClassSpecifier scs) = filter $ (≠ Just scs) . convert
  apply (NonFunctionSpecifier fs) = filter $ (≠ Just fs) . convert
  apply (NonCv cvq) = filter $ (≠ Just cvq) . convert
  apply (NonSign s) = maybe [] (toList . nonIntSpec s) . nonEmpty
  apply (NonLength s) = maybe [] (toList . nonIntSpec s) . nonEmpty
  apply LongLong = (convert LongSpec :) . (convert LongSpec :) . filter (compatible (convert LongSpec :: DeclSpecifier))

-- PtrOperator application

instance MaybeApply PtrOperator (Maybe AbstractDeclarator) where
  mapply o Nothing = return $ Just $ AbstractDeclarator_PtrAbstractDeclarator $ PtrAbstractDeclarator o Nothing
  mapply o (Just (AbstractDeclarator_PtrAbstractDeclarator pad)) =
    return $ Just $ AbstractDeclarator_PtrAbstractDeclarator $ apply o pad
  mapply _ (Just (AbstractDeclarator_Ellipsis _)) = throwError "Cannot apply ptr-operator to ellipsis."

instance Apply PtrOperator PtrAbstractDeclarator PtrAbstractDeclarator where
  apply o (PtrAbstractDeclarator_NoptrAbstractDeclarator npad) =
    PtrAbstractDeclarator_NoptrAbstractDeclarator (apply o npad)
  apply o (PtrAbstractDeclarator o' Nothing) =
    PtrAbstractDeclarator o' $ Just $ PtrAbstractDeclarator o Nothing
  apply o (PtrAbstractDeclarator o' (Just pad)) = PtrAbstractDeclarator o' $ Just $ apply o pad

instance Apply PtrOperator NoptrAbstractDeclarator NoptrAbstractDeclarator where
  apply o (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w pad w')) =
      NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w (apply o pad) w')
  apply o (NoptrAbstractDeclarator (Just npad) e) = NoptrAbstractDeclarator (Just $ apply o npad) e
  apply o (NoptrAbstractDeclarator Nothing e) =
    NoptrAbstractDeclarator (Just $ NoptrAbstractDeclarator_PtrAbstractDeclarator $ parenthesized (PtrAbstractDeclarator o Nothing)) e

instance Apply PtrOperator ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator)
    ([TypeSpecifier], PtrAbstractDeclarator) where
  apply o (specs, Left spec) = (specs ++ [spec], PtrAbstractDeclarator o Nothing)
  apply o (specs, Right ad) = (specs, apply o ad)

-- Declarator application

instance Apply (Maybe PtrAbstractDeclarator) ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator)
    ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator) where
  apply Nothing = id
  apply (Just ad) = second Right . apply ad

instance Apply PtrAbstractDeclarator ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator)
    ([TypeSpecifier], PtrAbstractDeclarator) where
  apply pad (specs, Left spec) = (specs ++ [spec], pad)
  apply pad (specs, Right pad') = (specs, apply pad pad')

instance Apply PtrAbstractDeclarator PtrAbstractDeclarator PtrAbstractDeclarator where
  apply pad (PtrAbstractDeclarator o Nothing) = PtrAbstractDeclarator o $ Just pad
  apply pad (PtrAbstractDeclarator o (Just pad')) = PtrAbstractDeclarator o $ Just $ apply pad pad'
  apply pad (PtrAbstractDeclarator_NoptrAbstractDeclarator npad') = PtrAbstractDeclarator_NoptrAbstractDeclarator (apply pad npad')

instance Apply PtrAbstractDeclarator NoptrAbstractDeclarator NoptrAbstractDeclarator where
  apply pad (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w pad' w')) =
    NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w (apply pad pad') w')
  apply (PtrAbstractDeclarator_NoptrAbstractDeclarator npad) npad' = apply npad npad'
  apply pad (NoptrAbstractDeclarator Nothing e) = NoptrAbstractDeclarator (Just $ NoptrAbstractDeclarator_PtrAbstractDeclarator $ parenthesized pad) e
  apply pad (NoptrAbstractDeclarator (Just npad) e) = NoptrAbstractDeclarator (Just $ apply pad npad) e

instance Apply NoptrAbstractDeclarator (Maybe NoptrAbstractDeclarator) NoptrAbstractDeclarator where
  apply x = maybe x (apply x)

instance Apply NoptrAbstractDeclarator NoptrAbstractDeclarator NoptrAbstractDeclarator where
  apply npad (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w pad w')) =
    NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w (apply (PtrAbstractDeclarator_NoptrAbstractDeclarator npad) pad) w')
  apply npad (NoptrAbstractDeclarator m e) = NoptrAbstractDeclarator (Just $ apply npad m) e

-- MakeDeclaration application

instance Convert [a] (Maybe (NeList a)) where convert = nonEmpty

instance Convert [DeclSpecifier] (Maybe DeclSpecifierSeq) where convert = fmap DeclSpecifierSeq . convert
instance Convert (Maybe DeclSpecifierSeq) [DeclSpecifier] where
  convert Nothing = []
  convert (Just (DeclSpecifierSeq l)) = toList l

instance Convert (Maybe DeclSpecifierSeq) [TypeSpecifier] where
  convert = convert . (convert :: Maybe DeclSpecifierSeq → [DeclSpecifier])

instance Apply MakeDeclaration (Maybe DeclSpecifierSeq, Declarator, Maybe (Either PureSpecifier BraceOrEqualInitializer)) (Maybe DeclSpecifierSeq, Declarator, Maybe (Either PureSpecifier BraceOrEqualInitializer)) where
  apply (MakeDeclaration specs m b) (specs', d, p) = (convert specs'', d', pure)
    where
      (specs'', d') = first (convert :: Maybe DeclSpecifierSeq → [DeclSpecifier]) $ apply (specs, m) (specs', d)
      pure = if any (\ms → case ms of NonFunctionSpecifier Virtual → True; MakeSpecifier_DeclSpecifier (DeclSpecifier_StorageClassSpecifier (Static, _)) → True; _ → False) specs then Nothing else case b of Definitely → Just $ Left $ PureSpecifier (IsOperator, White " ") (KwdZero, White " "); Indeterminate → p; DefinitelyNot → Nothing

instance MaybeApply MakeDeclaration FunctionDefinition where
  mapply (MakeDeclaration _ _ Definitely) _ = throwError "Cannot purify function-definition."
  mapply (MakeDeclaration specs' mpad _) (FunctionDefinition specs decl body) =
    return $ FunctionDefinition specs'' decl' body
   where (specs'', decl') = apply (specs', mpad) (specs, decl)

instance MaybeApply MakeDeclaration ParameterDeclaration where
  mapply (MakeDeclaration _ _ Definitely) _ = throwError "Cannot purify parameter-declaration."
  mapply (MakeDeclaration specs' mpad _) (ParameterDeclaration specs x m) = (\(specs'', x') → ParameterDeclaration specs'' x' m) . mapply (specs', mpad) (specs, x)

instance MaybeApply MakeDeclaration ForRangeDeclaration where
  mapply (MakeDeclaration _ _ Definitely) _ = throwError "Cannot purify for-range-declaration."
  mapply (MakeDeclaration specs' mpad _) (ForRangeDeclaration specs d) =
    return $ uncurry ForRangeDeclaration $ apply (specs', mpad) (specs, d)

-- cv-qualifier application

instance Apply CvQualifier (Maybe CvQualifierSeq) (Maybe CvQualifierSeq) where
  apply cvq Nothing = Just $ CvQualifierSeq $ return (cvq, White " ")
  apply cvq (Just x) = Just $ apply cvq x
instance Apply CvQualifier CvQualifierSeq CvQualifierSeq where
  apply cvq (CvQualifierSeq l) = CvQualifierSeq $ if any ((== cvq) . fst) l then l else NeList.cons (cvq, White " ") l

instance MaybeApply CvQualifier a ⇒ MaybeApply [CvQualifier] a where
  mapply l x = foldM (flip mapply) x l

instance MaybeApply CvQualifier PtrOperator where
  mapply cvq (PtrOperator_Nested mw n w cvq') = return $ PtrOperator_Nested mw n w $ apply cvq cvq'
  mapply cvq (PtrOperator_Ptr w cvq') = return $ PtrOperator_Ptr w $ apply cvq cvq'
  mapply _ (PtrOperator_Ref _) = throwError "Cannot cv-qualify reference."

instance (Convert CvQualifier t, Compatible t t) ⇒ Apply CvQualifier [t] [t] where
  apply cvq l = let x = convert cvq in if any (not . compatible x) l then l else x : l

instance (Convert CvQualifier t, Compatible t t) ⇒ Apply CvQualifier (NeList t) (NeList t) where
  apply cvq l = let x = convert cvq in if any (not . compatible x) (toList l) then l else NeList.cons x l
  -- todo: merge last two using ListLike

instance Apply CvQualifier x x ⇒ Apply CvQualifier (x, Maybe PtrAbstractDeclarator) (x, Maybe PtrAbstractDeclarator) where
  apply cvq (l, Just ad) | Just ad' ← mapply cvq ad = (l, Just ad')
  apply cvq (l, mad) = (apply cvq l, mad)

instance MaybeApply CvQualifier InitDeclarator where
  mapply cvq (InitDeclarator d mi) = flip InitDeclarator mi . mapply cvq d

instance MaybeApply CvQualifier Declarator where
  mapply cvq (Declarator_PtrDeclarator d) = Declarator_PtrDeclarator . mapply cvq d
  mapply _ _ = throwError "Sorry, not yet implemented."

instance MaybeApply CvQualifier PtrDeclarator where
  mapply cvq (PtrDeclarator_NoptrDeclarator d) = PtrDeclarator_NoptrDeclarator . mapply cvq d
  mapply cvq (PtrDeclarator o d) = case mapply cvq d of
    Just d' → return $ PtrDeclarator o d'
    Nothing → flip PtrDeclarator d . mapply cvq o

instance MaybeApply CvQualifier NoptrDeclarator where
  mapply cvq (NoptrDeclarator_WithParams d p) = return $ case mapply cvq d of
      Just d' → NoptrDeclarator_WithParams d' p
      Nothing → NoptrDeclarator_WithParams d $ apply cvq p
  mapply cvq (NoptrDeclarator_Parenthesized (Parenthesized w d w'))
    = NoptrDeclarator_Parenthesized . (\x → Parenthesized w x w') . mapply cvq d
  mapply cvq (NoptrDeclarator_Squared d s) = flip NoptrDeclarator_Squared s . mapply cvq d
  mapply _ (NoptrDeclarator_Id _) = throwError "Cannot cv-qualify declarator-id."

instance Apply CvQualifier ParametersAndQualifiers ParametersAndQualifiers where
  apply cvq (ParametersAndQualifiers d cvq' m e) = ParametersAndQualifiers d (apply cvq cvq') m e

instance Apply CvQualifier ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator)
    ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator) where
  apply cvq (l, Right ad)
    | Just ad' ← mapply cvq ad = (l, Right ad')
    | otherwise = (apply cvq l, Right ad)
  apply cvq (l, Left s) = let (s', l') = neElim $ apply cvq (s :| l) in (l', Left s')

instance MaybeApply CvQualifier PtrAbstractDeclarator where
  mapply cvq (PtrAbstractDeclarator_NoptrAbstractDeclarator d) =
    PtrAbstractDeclarator_NoptrAbstractDeclarator . mapply cvq d
  mapply cvq (PtrAbstractDeclarator o Nothing) = flip PtrAbstractDeclarator Nothing . mapply cvq o
  mapply cvq (PtrAbstractDeclarator o (Just a)) = case mapply cvq a of
    Just a' → return $ PtrAbstractDeclarator o (Just a')
    Nothing → flip PtrAbstractDeclarator (Just a) . mapply cvq o

instance MaybeApply CvQualifier NoptrAbstractDeclarator where
  mapply cvq (NoptrAbstractDeclarator (Just d) (Right t)) = flip NoptrAbstractDeclarator (Right t) . Just . mapply cvq d
  mapply _ (NoptrAbstractDeclarator Nothing (Right _)) = throwError "Cannot cv-qualify leaf array noptr-abstract-declarator."
  mapply cvq (NoptrAbstractDeclarator m (Left p)) = return $ case m >>= mapply cvq of
      Nothing → NoptrAbstractDeclarator m $ Left $ apply cvq p
      Just m' → NoptrAbstractDeclarator (Just m') $ Left p
  mapply cvq (NoptrAbstractDeclarator_PtrAbstractDeclarator (Parenthesized w d w')) =
    NoptrAbstractDeclarator_PtrAbstractDeclarator . (\x → Parenthesized w x w') . mapply cvq d

-- Determination of whether declarators declare pointers/references

class IsPointerOrReference t r | t → r where is_pointer_or_reference :: t → r

instance IsPointerOrReference Declarator Bool where
  is_pointer_or_reference (Declarator_PtrDeclarator d) = case is_pointer_or_reference d of
    Definitely → True; _ → False
  is_pointer_or_reference (Declarator_TrailingReturnType _ _ _) = False
instance IsPointerOrReference PtrDeclarator TriBool where
  is_pointer_or_reference (PtrDeclarator_NoptrDeclarator d) = is_pointer_or_reference d
  is_pointer_or_reference (PtrDeclarator _ d) = case is_pointer_or_reference d of
    DefinitelyNot → DefinitelyNot; _ → Definitely
instance IsPointerOrReference NoptrDeclarator TriBool where
  is_pointer_or_reference (NoptrDeclarator_Id _) = Indeterminate
  is_pointer_or_reference (NoptrDeclarator_WithParams d _) = case is_pointer_or_reference d of
    Definitely → Definitely; _ → DefinitelyNot
  is_pointer_or_reference (NoptrDeclarator_Squared d _) = case is_pointer_or_reference d of
    Definitely → Definitely; _ → DefinitelyNot
  is_pointer_or_reference (NoptrDeclarator_Parenthesized (Parenthesized _ (Enclosed d) _)) = is_pointer_or_reference d