{-# 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 prop…