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

import           Data.Maybe          (maybeToList)
import           GHC.Generics
import           Language.Cimple.Ast (AssignOp, BinaryOp, 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 :: forall p. U1 p -> [a]
gconcats U1 p
U1 = []

instance (GenConcats f a, GenConcats g a) => GenConcats (f :+: g) a where
    gconcats :: forall p. (:+:) 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 :: forall p. (:*:) 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 :: forall p. 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 t a => GenConcats (Rec0 t) a where
    gconcats :: forall p. 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

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