{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeOperators         #-}
module Language.Cimple.Flatten (lexemes) where

import           Data.Fix            (Fix (..))
import           Data.Maybe          (maybeToList)
import           GHC.Generics
import           Language.Cimple.Ast (AssignOp, BinaryOp, CommentF (..),
                                      CommentStyle, LiteralType, NodeF (..),
                                      Scope, UnaryOp)

class Concats t a where
    concats :: t -> [a]

    default concats :: (Generic t, GenConcats (Rep t) a) => t -> [a]
    concats = Rep t Any -> [a]
forall (f :: * -> *) a p. GenConcats f a => f p -> [a]
gconcats (Rep t Any -> [a]) -> (t -> Rep t Any) -> t -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Rep t Any
forall a x. Generic a => a -> Rep a x
from

class GenConcats f a where
    gconcats :: f p -> [a]

instance GenConcats U1 a where
    gconcats :: U1 p -> [a]
gconcats U1 p
U1 = []

instance (GenConcats f a, GenConcats g a) => GenConcats (f :+: g) a where
    gconcats :: (:+:) f g p -> [a]
gconcats (L1 f p
x) = f p -> [a]
forall (f :: * -> *) a p. GenConcats f a => f p -> [a]
gconcats f p
x
    gconcats (R1 g p
x) = g p -> [a]
forall (f :: * -> *) a p. GenConcats f a => f p -> [a]
gconcats g p
x

instance (GenConcats f a, GenConcats g a) => GenConcats (f :*: g) a where
    gconcats :: (:*:) f g p -> [a]
gconcats (f p
x :*: g p
y) = f p -> [a]
forall (f :: * -> *) a p. GenConcats f a => f p -> [a]
gconcats f p
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ g p -> [a]
forall (f :: * -> *) a p. GenConcats f a => f p -> [a]
gconcats g p
y

instance GenConcats f a => GenConcats (M1 i t f) a where
    gconcats :: M1 i t f p -> [a]
gconcats (M1 f p
x) = f p -> [a]
forall (f :: * -> *) a p. GenConcats f a => f p -> [a]
gconcats f p
x

class GenConcatsFlatten t a where
    gconcatsFlatten :: t -> [a]

instance GenConcatsFlatten UnaryOp      a where gconcatsFlatten :: UnaryOp -> [a]
gconcatsFlatten = [a] -> UnaryOp -> [a]
forall a b. a -> b -> a
const []
instance GenConcatsFlatten BinaryOp     a where gconcatsFlatten :: BinaryOp -> [a]
gconcatsFlatten = [a] -> BinaryOp -> [a]
forall a b. a -> b -> a
const []
instance GenConcatsFlatten AssignOp     a where gconcatsFlatten :: AssignOp -> [a]
gconcatsFlatten = [a] -> AssignOp -> [a]
forall a b. a -> b -> a
const []
instance GenConcatsFlatten Scope        a where gconcatsFlatten :: Scope -> [a]
gconcatsFlatten = [a] -> Scope -> [a]
forall a b. a -> b -> a
const []
instance GenConcatsFlatten CommentStyle a where gconcatsFlatten :: CommentStyle -> [a]
gconcatsFlatten = [a] -> CommentStyle -> [a]
forall a b. a -> b -> a
const []
instance GenConcatsFlatten LiteralType  a where gconcatsFlatten :: LiteralType -> [a]
gconcatsFlatten = [a] -> LiteralType -> [a]
forall a b. a -> b -> a
const []

instance GenConcatsFlatten b a => GenConcatsFlatten (Maybe b) a where
    gconcatsFlatten :: Maybe b -> [a]
gconcatsFlatten = [b] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten ([b] -> [a]) -> (Maybe b -> [b]) -> Maybe b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> [b]
forall a. Maybe a -> [a]
maybeToList

instance {-# OVERLAPPING #-} GenConcatsFlatten a a where
    gconcatsFlatten :: a -> [a]
gconcatsFlatten = a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance {-# OVERLAPPABLE #-} GenConcatsFlatten b a => GenConcatsFlatten [b] a where
    gconcatsFlatten :: [b] -> [a]
gconcatsFlatten = (b -> [a]) -> [b] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap b -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten

instance GenConcatsFlatten (Fix (CommentF a)) a where
    -- TODO(iphydf): Figure out how to write this using Generics.
    gconcatsFlatten :: Fix (CommentF a) -> [a]
gconcatsFlatten (Fix CommentF a (Fix (CommentF a))
DocNewline) = []
    gconcatsFlatten (Fix CommentF a (Fix (CommentF a))
DocPrivate) = []
    gconcatsFlatten (Fix (DocAssignOp AssignOp
_ Fix (CommentF a)
l Fix (CommentF a)
r)) = (Fix (CommentF a) -> [a]) -> [Fix (CommentF a)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fix (CommentF a) -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)
l, Fix (CommentF a)
r]
    gconcatsFlatten (Fix (DocAttention [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocBinaryOp BinaryOp
_ Fix (CommentF a)
l Fix (CommentF a)
r)) = (Fix (CommentF a) -> [a]) -> [Fix (CommentF a)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fix (CommentF a) -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)
l, Fix (CommentF a)
r]
    gconcatsFlatten (Fix (DocBrief [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocColon a
x)) = a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
x
    gconcatsFlatten (Fix (DocComment [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocDeprecated [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocExtends a
x)) = a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
x
    gconcatsFlatten (Fix (DocImplements a
x)) = a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
x
    gconcatsFlatten (Fix (DocLine [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocCode a
b [Fix (CommentF a)]
x a
e)) = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
b, [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x, a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
e]
    gconcatsFlatten (Fix (DocList [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocLParen Fix (CommentF a)
x)) = Fix (CommentF a) -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten Fix (CommentF a)
x
    gconcatsFlatten (Fix (DocOLItem a
i [Fix (CommentF a)]
x)) = a
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocParagraph [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocParam Maybe a
a a
p [Fix (CommentF a)]
x)) = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten Maybe a
a, a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
p, [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x]
    gconcatsFlatten (Fix (DocP a
x)) = a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
x
    gconcatsFlatten (Fix (DocRef a
x)) = a -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten a
x
    gconcatsFlatten (Fix (DocReturn [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocRetval a
r [Fix (CommentF a)]
x)) = a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocRParen Fix (CommentF a)
x)) = Fix (CommentF a) -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten Fix (CommentF a)
x
    gconcatsFlatten (Fix (DocSee a
r [Fix (CommentF a)]
x)) = a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocSentence [Fix (CommentF a)]
x a
p)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
p]
    gconcatsFlatten (Fix (DocULItem [Fix (CommentF a)]
i [Fix (CommentF a)]
x)) = [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
i [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [Fix (CommentF a)] -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten [Fix (CommentF a)]
x
    gconcatsFlatten (Fix (DocWord a
x)) = [a
x]

instance GenConcatsFlatten t a => GenConcats (Rec0 t) a where
    gconcats :: Rec0 t p -> [a]
gconcats (K1 t
x) = t -> [a]
forall t a. GenConcatsFlatten t a => t -> [a]
gconcatsFlatten t
x

-- Uses the default signature, which delegates to the generic stuff
instance Concats (NodeF a [a]) a
instance Concats (CommentF a [a]) a

lexemes :: NodeF lexeme [lexeme] -> [lexeme]
lexemes :: NodeF lexeme [lexeme] -> [lexeme]
lexemes = NodeF lexeme [lexeme] -> [lexeme]
forall t a. Concats t a => t -> [a]
concats