{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Views of C datatypes. While "Language.C.Types.Parse" defines datatypes for
-- representing the concrete syntax tree of C types, this module provides
-- friendlier views of C types, by turning them into a data type matching more
-- closely how we read and think about types, both in Haskell and in C. To
-- appreciate the difference, look at the difference between
-- 'P.ParameterDeclaration' and 'ParameterDeclaration'.
--
-- As a bonus, routines are provided for describing types in natural language
-- (English) -- see 'describeParameterDeclaration' and 'describeType'.

module Language.C.Types
  ( -- * Types
    P.CIdentifier
  , P.unCIdentifier
  , P.cIdentifierFromString
  , P.StorageClassSpecifier(..)
  , P.TypeQualifier(..)
  , P.FunctionSpecifier(..)
  , P.ArrayType(..)
  , Specifiers(..)
  , Type(..)
  , TypeSpecifier(..)
  , Sign(..)
  , ParameterDeclaration(..)

    -- * Parsing
  , P.TypeNames
  , P.CParser
  , P.CParserContext
  , P.cCParserContext
  , P.runCParser
  , P.quickCParser
  , P.quickCParser_
  , parseParameterDeclaration
  , parseParameterList
  , parseIdentifier
  , parseEnableCpp
  , parseType

    -- * Convert to and from high-level views
  , UntangleErr(..)
  , untangleParameterDeclaration
  , tangleParameterDeclaration

    -- * To english
  , describeParameterDeclaration
  , describeType
  ) where

import           Control.Arrow (second)
import           Control.Monad (when, unless, forM_, forM)
import           Control.Monad.State (execState, modify)
import           Control.Monad.Reader (ask)
import           Data.List (partition, intersperse)
import           Data.Maybe (fromMaybe)
import           Data.String (fromString)
import           Data.Typeable (Typeable)
import           Prettyprinter ((<+>))
import qualified Prettyprinter as PP
import qualified Prettyprinter.Render.String as PP

#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup (Semigroup, (<>))
#else
import           Data.Monoid ((<>))
#endif

#if __GLASGOW_HASKELL__ < 710
import           Data.Foldable (Foldable)
import           Data.Functor ((<$>))
import           Data.Monoid (Monoid(..))
import           Data.Traversable (Traversable)
#endif

import qualified Language.C.Types.Parse as P

------------------------------------------------------------------------
-- Proper types

data TypeSpecifier
  = Void
  | Bool
  | Char (Maybe Sign)
  | Short Sign
  | Int Sign
  | Long Sign
  | LLong Sign
  | Float
  | Double
  | LDouble
  | TypeName P.CIdentifier
  | Struct P.CIdentifier
  | Enum P.CIdentifier
  | Template P.CIdentifier [TypeSpecifier]
  | TemplateConst String
  | TemplatePointer TypeSpecifier
  deriving (Typeable, Int -> TypeSpecifier -> ShowS
[TypeSpecifier] -> ShowS
TypeSpecifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSpecifier] -> ShowS
$cshowList :: [TypeSpecifier] -> ShowS
show :: TypeSpecifier -> String
$cshow :: TypeSpecifier -> String
showsPrec :: Int -> TypeSpecifier -> ShowS
$cshowsPrec :: Int -> TypeSpecifier -> ShowS
Show, TypeSpecifier -> TypeSpecifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSpecifier -> TypeSpecifier -> Bool
$c/= :: TypeSpecifier -> TypeSpecifier -> Bool
== :: TypeSpecifier -> TypeSpecifier -> Bool
$c== :: TypeSpecifier -> TypeSpecifier -> Bool
Eq, Eq TypeSpecifier
TypeSpecifier -> TypeSpecifier -> Bool
TypeSpecifier -> TypeSpecifier -> Ordering
TypeSpecifier -> TypeSpecifier -> TypeSpecifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
$cmin :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
max :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
$cmax :: TypeSpecifier -> TypeSpecifier -> TypeSpecifier
>= :: TypeSpecifier -> TypeSpecifier -> Bool
$c>= :: TypeSpecifier -> TypeSpecifier -> Bool
> :: TypeSpecifier -> TypeSpecifier -> Bool
$c> :: TypeSpecifier -> TypeSpecifier -> Bool
<= :: TypeSpecifier -> TypeSpecifier -> Bool
$c<= :: TypeSpecifier -> TypeSpecifier -> Bool
< :: TypeSpecifier -> TypeSpecifier -> Bool
$c< :: TypeSpecifier -> TypeSpecifier -> Bool
compare :: TypeSpecifier -> TypeSpecifier -> Ordering
$ccompare :: TypeSpecifier -> TypeSpecifier -> Ordering
Ord)

data Specifiers = Specifiers
  { Specifiers -> [StorageClassSpecifier]
storageClassSpecifiers :: [P.StorageClassSpecifier]
  , Specifiers -> [TypeQualifier]
typeQualifiers :: [P.TypeQualifier]
  , Specifiers -> [FunctionSpecifier]
functionSpecifiers :: [P.FunctionSpecifier]
  } deriving (Typeable, Int -> Specifiers -> ShowS
[Specifiers] -> ShowS
Specifiers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specifiers] -> ShowS
$cshowList :: [Specifiers] -> ShowS
show :: Specifiers -> String
$cshow :: Specifiers -> String
showsPrec :: Int -> Specifiers -> ShowS
$cshowsPrec :: Int -> Specifiers -> ShowS
Show, Specifiers -> Specifiers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Specifiers -> Specifiers -> Bool
$c/= :: Specifiers -> Specifiers -> Bool
== :: Specifiers -> Specifiers -> Bool
$c== :: Specifiers -> Specifiers -> Bool
Eq)

#if MIN_VERSION_base(4,9,0)
instance Semigroup Specifiers where
  Specifiers [StorageClassSpecifier]
x1 [TypeQualifier]
y1 [FunctionSpecifier]
z1 <> :: Specifiers -> Specifiers -> Specifiers
<> Specifiers [StorageClassSpecifier]
x2 [TypeQualifier]
y2 [FunctionSpecifier]
z2 =
    [StorageClassSpecifier]
-> [TypeQualifier] -> [FunctionSpecifier] -> Specifiers
Specifiers ([StorageClassSpecifier]
x1 forall a. [a] -> [a] -> [a]
++ [StorageClassSpecifier]
x2) ([TypeQualifier]
y1 forall a. [a] -> [a] -> [a]
++ [TypeQualifier]
y2) ([FunctionSpecifier]
z1 forall a. [a] -> [a] -> [a]
++ [FunctionSpecifier]
z2)
#endif

instance Monoid Specifiers where
  mempty :: Specifiers
mempty = [StorageClassSpecifier]
-> [TypeQualifier] -> [FunctionSpecifier] -> Specifiers
Specifiers [] [] []

#if !MIN_VERSION_base(4,11,0)
  mappend (Specifiers x1 y1 z1) (Specifiers x2 y2 z2) =
    Specifiers (x1 ++ x2) (y1 ++ y2) (z1 ++ z2)
#endif

data Type i
  = TypeSpecifier Specifiers TypeSpecifier
  | Ptr [P.TypeQualifier] (Type i)
  | Array (P.ArrayType i) (Type i)
  | Proto (Type i) [ParameterDeclaration i]
  deriving (Typeable, Int -> Type i -> ShowS
forall i. Show i => Int -> Type i -> ShowS
forall i. Show i => [Type i] -> ShowS
forall i. Show i => Type i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type i] -> ShowS
$cshowList :: forall i. Show i => [Type i] -> ShowS
show :: Type i -> String
$cshow :: forall i. Show i => Type i -> String
showsPrec :: Int -> Type i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> Type i -> ShowS
Show, Type i -> Type i -> Bool
forall i. Eq i => Type i -> Type i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type i -> Type i -> Bool
$c/= :: forall i. Eq i => Type i -> Type i -> Bool
== :: Type i -> Type i -> Bool
$c== :: forall i. Eq i => Type i -> Type i -> Bool
Eq, forall a b. a -> Type b -> Type a
forall a b. (a -> b) -> Type a -> Type b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Type b -> Type a
$c<$ :: forall a b. a -> Type b -> Type a
fmap :: forall a b. (a -> b) -> Type a -> Type b
$cfmap :: forall a b. (a -> b) -> Type a -> Type b
Functor, forall a. Eq a => a -> Type a -> Bool
forall a. Num a => Type a -> a
forall a. Ord a => Type a -> a
forall m. Monoid m => Type m -> m
forall a. Type a -> Bool
forall a. Type a -> Int
forall a. Type a -> [a]
forall a. (a -> a -> a) -> Type a -> a
forall m a. Monoid m => (a -> m) -> Type a -> m
forall b a. (b -> a -> b) -> b -> Type a -> b
forall a b. (a -> b -> b) -> b -> Type a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Type a -> a
$cproduct :: forall a. Num a => Type a -> a
sum :: forall a. Num a => Type a -> a
$csum :: forall a. Num a => Type a -> a
minimum :: forall a. Ord a => Type a -> a
$cminimum :: forall a. Ord a => Type a -> a
maximum :: forall a. Ord a => Type a -> a
$cmaximum :: forall a. Ord a => Type a -> a
elem :: forall a. Eq a => a -> Type a -> Bool
$celem :: forall a. Eq a => a -> Type a -> Bool
length :: forall a. Type a -> Int
$clength :: forall a. Type a -> Int
null :: forall a. Type a -> Bool
$cnull :: forall a. Type a -> Bool
toList :: forall a. Type a -> [a]
$ctoList :: forall a. Type a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Type a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Type a -> a
foldr1 :: forall a. (a -> a -> a) -> Type a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Type a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Type a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Type a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Type a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Type a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Type a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Type a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Type a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Type a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Type a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Type a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Type a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Type a -> m
fold :: forall m. Monoid m => Type m -> m
$cfold :: forall m. Monoid m => Type m -> m
Foldable, Functor Type
Foldable Type
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
sequence :: forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
$csequence :: forall (m :: * -> *) a. Monad m => Type (m a) -> m (Type a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Type a -> m (Type b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Type (f a) -> f (Type a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Type a -> f (Type b)
Traversable)

data Sign
  = Signed
  | Unsigned
  deriving (Typeable, Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show, Sign -> Sign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq, Eq Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmax :: Sign -> Sign -> Sign
>= :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c< :: Sign -> Sign -> Bool
compare :: Sign -> Sign -> Ordering
$ccompare :: Sign -> Sign -> Ordering
Ord)

data ParameterDeclaration i = ParameterDeclaration
  { forall i. ParameterDeclaration i -> Maybe i
parameterDeclarationId :: Maybe i
  , forall i. ParameterDeclaration i -> Type i
parameterDeclarationType :: (Type i)
  } deriving (Typeable, Int -> ParameterDeclaration i -> ShowS
forall i. Show i => Int -> ParameterDeclaration i -> ShowS
forall i. Show i => [ParameterDeclaration i] -> ShowS
forall i. Show i => ParameterDeclaration i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterDeclaration i] -> ShowS
$cshowList :: forall i. Show i => [ParameterDeclaration i] -> ShowS
show :: ParameterDeclaration i -> String
$cshow :: forall i. Show i => ParameterDeclaration i -> String
showsPrec :: Int -> ParameterDeclaration i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> ParameterDeclaration i -> ShowS
Show, ParameterDeclaration i -> ParameterDeclaration i -> Bool
forall i.
Eq i =>
ParameterDeclaration i -> ParameterDeclaration i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterDeclaration i -> ParameterDeclaration i -> Bool
$c/= :: forall i.
Eq i =>
ParameterDeclaration i -> ParameterDeclaration i -> Bool
== :: ParameterDeclaration i -> ParameterDeclaration i -> Bool
$c== :: forall i.
Eq i =>
ParameterDeclaration i -> ParameterDeclaration i -> Bool
Eq, forall a b. a -> ParameterDeclaration b -> ParameterDeclaration a
forall a b.
(a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParameterDeclaration b -> ParameterDeclaration a
$c<$ :: forall a b. a -> ParameterDeclaration b -> ParameterDeclaration a
fmap :: forall a b.
(a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
$cfmap :: forall a b.
(a -> b) -> ParameterDeclaration a -> ParameterDeclaration b
Functor, forall a. Eq a => a -> ParameterDeclaration a -> Bool
forall a. Num a => ParameterDeclaration a -> a
forall a. Ord a => ParameterDeclaration a -> a
forall m. Monoid m => ParameterDeclaration m -> m
forall a. ParameterDeclaration a -> Bool
forall a. ParameterDeclaration a -> Int
forall a. ParameterDeclaration a -> [a]
forall a. (a -> a -> a) -> ParameterDeclaration a -> a
forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ParameterDeclaration a -> a
$cproduct :: forall a. Num a => ParameterDeclaration a -> a
sum :: forall a. Num a => ParameterDeclaration a -> a
$csum :: forall a. Num a => ParameterDeclaration a -> a
minimum :: forall a. Ord a => ParameterDeclaration a -> a
$cminimum :: forall a. Ord a => ParameterDeclaration a -> a
maximum :: forall a. Ord a => ParameterDeclaration a -> a
$cmaximum :: forall a. Ord a => ParameterDeclaration a -> a
elem :: forall a. Eq a => a -> ParameterDeclaration a -> Bool
$celem :: forall a. Eq a => a -> ParameterDeclaration a -> Bool
length :: forall a. ParameterDeclaration a -> Int
$clength :: forall a. ParameterDeclaration a -> Int
null :: forall a. ParameterDeclaration a -> Bool
$cnull :: forall a. ParameterDeclaration a -> Bool
toList :: forall a. ParameterDeclaration a -> [a]
$ctoList :: forall a. ParameterDeclaration a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ParameterDeclaration a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ParameterDeclaration a -> a
foldr1 :: forall a. (a -> a -> a) -> ParameterDeclaration a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ParameterDeclaration a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ParameterDeclaration a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ParameterDeclaration a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ParameterDeclaration a -> m
fold :: forall m. Monoid m => ParameterDeclaration m -> m
$cfold :: forall m. Monoid m => ParameterDeclaration m -> m
Foldable, Functor ParameterDeclaration
Foldable ParameterDeclaration
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ParameterDeclaration (m a) -> m (ParameterDeclaration a)
forall (f :: * -> *) a.
Applicative f =>
ParameterDeclaration (f a) -> f (ParameterDeclaration a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
sequence :: forall (m :: * -> *) a.
Monad m =>
ParameterDeclaration (m a) -> m (ParameterDeclaration a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ParameterDeclaration (m a) -> m (ParameterDeclaration a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ParameterDeclaration a -> m (ParameterDeclaration b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ParameterDeclaration (f a) -> f (ParameterDeclaration a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ParameterDeclaration (f a) -> f (ParameterDeclaration a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ParameterDeclaration a -> f (ParameterDeclaration b)
Traversable)

------------------------------------------------------------------------
-- Conversion

data UntangleErr
  = MultipleDataTypes [P.DeclarationSpecifier]
  | NoDataTypes [P.DeclarationSpecifier]
  | IllegalSpecifiers String [P.TypeSpecifier]
  deriving (Typeable, Int -> UntangleErr -> ShowS
[UntangleErr] -> ShowS
UntangleErr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntangleErr] -> ShowS
$cshowList :: [UntangleErr] -> ShowS
show :: UntangleErr -> String
$cshow :: UntangleErr -> String
showsPrec :: Int -> UntangleErr -> ShowS
$cshowsPrec :: Int -> UntangleErr -> ShowS
Show, UntangleErr -> UntangleErr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntangleErr -> UntangleErr -> Bool
$c/= :: UntangleErr -> UntangleErr -> Bool
== :: UntangleErr -> UntangleErr -> Bool
$c== :: UntangleErr -> UntangleErr -> Bool
Eq)

failConversion :: UntangleErr -> Either UntangleErr a
failConversion :: forall a. UntangleErr -> Either UntangleErr a
failConversion = forall a b. a -> Either a b
Left

untangleParameterDeclaration
  :: P.ParameterDeclaration i -> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration :: forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration P.ParameterDeclaration{[DeclarationSpecifier]
DeclaratorOrAbstractDeclarator i
parameterDeclarationDeclarator :: forall i.
ParameterDeclaration i -> DeclaratorOrAbstractDeclarator i
parameterDeclarationSpecifiers :: forall i. ParameterDeclaration i -> [DeclarationSpecifier]
parameterDeclarationDeclarator :: DeclaratorOrAbstractDeclarator i
parameterDeclarationSpecifiers :: [DeclarationSpecifier]
..} = do
  (Specifiers
specs, TypeSpecifier
tySpec) <- [DeclarationSpecifier]
-> Either UntangleErr (Specifiers, TypeSpecifier)
untangleDeclarationSpecifiers [DeclarationSpecifier]
parameterDeclarationSpecifiers
  let baseTy :: Type i
baseTy = forall i. Specifiers -> TypeSpecifier -> Type i
TypeSpecifier Specifiers
specs TypeSpecifier
tySpec
  (Maybe i
mbS, Type i
ty) <- case DeclaratorOrAbstractDeclarator i
parameterDeclarationDeclarator of
    P.IsDeclarator Declarator i
decltor -> do
      (i
s, Type i
ty) <- forall i. Type i -> Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator forall {i}. Type i
baseTy Declarator i
decltor
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just i
s, Type i
ty)
    P.IsAbstractDeclarator AbstractDeclarator i
decltor ->
      (forall a. Maybe a
Nothing, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i.
Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator forall {i}. Type i
baseTy AbstractDeclarator i
decltor
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i. Maybe i -> Type i -> ParameterDeclaration i
ParameterDeclaration Maybe i
mbS Type i
ty

untangleDeclarationSpecifiers
  :: [P.DeclarationSpecifier] -> Either UntangleErr (Specifiers, TypeSpecifier)
untangleDeclarationSpecifiers :: [DeclarationSpecifier]
-> Either UntangleErr (Specifiers, TypeSpecifier)
untangleDeclarationSpecifiers [DeclarationSpecifier]
declSpecs = do
  let ([StorageClassSpecifier]
pStorage, [TypeSpecifier]
pTySpecs, [TypeQualifier]
pTyQuals, [FunctionSpecifier]
pFunSpecs) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState ([], [], [], []) forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
reverse [DeclarationSpecifier]
declSpecs) forall a b. (a -> b) -> a -> b
$ \DeclarationSpecifier
declSpec -> case DeclarationSpecifier
declSpec of
          P.StorageClassSpecifier StorageClassSpecifier
x -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> (StorageClassSpecifier
xforall a. a -> [a] -> [a]
:[StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d)
          P.TypeSpecifier TypeSpecifier
x -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> ([StorageClassSpecifier]
a, TypeSpecifier
xforall a. a -> [a] -> [a]
:[TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d)
          P.TypeQualifier TypeQualifier
x -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> ([StorageClassSpecifier]
a, [TypeSpecifier]
b, TypeQualifier
xforall a. a -> [a] -> [a]
:[TypeQualifier]
c, [FunctionSpecifier]
d)
          P.FunctionSpecifier FunctionSpecifier
x -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, [FunctionSpecifier]
d) -> ([StorageClassSpecifier]
a, [TypeSpecifier]
b, [TypeQualifier]
c, FunctionSpecifier
xforall a. a -> [a] -> [a]
:[FunctionSpecifier]
d)
  TypeSpecifier
tySpec <- [TypeSpecifier] -> Either UntangleErr TypeSpecifier
type2type [TypeSpecifier]
pTySpecs
  forall (m :: * -> *) a. Monad m => a -> m a
return ([StorageClassSpecifier]
-> [TypeQualifier] -> [FunctionSpecifier] -> Specifiers
Specifiers [StorageClassSpecifier]
pStorage [TypeQualifier]
pTyQuals [FunctionSpecifier]
pFunSpecs, TypeSpecifier
tySpec)
  where
    type2type :: [TypeSpecifier] -> Either UntangleErr TypeSpecifier
type2type [TypeSpecifier]
pTySpecs = do
      -- Split data type and specifiers
      let ([TypeSpecifier]
dataTypes, [TypeSpecifier]
specs) =
            forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\TypeSpecifier
x -> Bool -> Bool
not (TypeSpecifier
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TypeSpecifier
P.SIGNED, TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.LONG, TypeSpecifier
P.SHORT])) [TypeSpecifier]
pTySpecs
      let illegalSpecifiers :: String -> Either UntangleErr a
illegalSpecifiers String
s = forall a. UntangleErr -> Either UntangleErr a
failConversion forall a b. (a -> b) -> a -> b
$ String -> [TypeSpecifier] -> UntangleErr
IllegalSpecifiers String
s [TypeSpecifier]
specs
      -- Find out sign, if present
      Maybe Sign
mbSign0 <- case forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.SIGNED) [TypeSpecifier]
specs of
        []  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        [TypeSpecifier
_] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Sign
Signed
        TypeSpecifier
_:[TypeSpecifier]
_ -> forall {a}. String -> Either UntangleErr a
illegalSpecifiers String
"conflicting/duplicate sign information"
      Maybe Sign
mbSign <- case (Maybe Sign
mbSign0, forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.UNSIGNED) [TypeSpecifier]
specs) of
        (Maybe Sign
Nothing, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        (Maybe Sign
Nothing, [TypeSpecifier
_]) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Sign
Unsigned
        (Just Sign
b, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Sign
b
        (Maybe Sign, [TypeSpecifier])
_ -> forall {a}. String -> Either UntangleErr a
illegalSpecifiers String
"conflicting/duplicate sign information"
      let sign :: Sign
sign = forall a. a -> Maybe a -> a
fromMaybe Sign
Signed Maybe Sign
mbSign
      -- Find out length
      let longs :: Int
longs = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.LONG) [TypeSpecifier]
specs
      let shorts :: Int
shorts = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== TypeSpecifier
P.SHORT) [TypeSpecifier]
specs
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
longs forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
shorts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall {a}. String -> Either UntangleErr a
illegalSpecifiers String
"both long and short"
      -- Find out data type
      TypeSpecifier
dataType <- case [TypeSpecifier]
dataTypes of
        [TypeSpecifier
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
x
        [] | Maybe Sign
mbSign0 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Sign
Signed -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
P.INT -- "The Case of 'signed' not including 'signed int'"
        [] | Maybe Sign
mbSign forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Sign
Unsigned -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
P.INT -- "The Case of 'unsigned' not including 'unsigned int'"
        [] | Int
longs forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
shorts forall a. Ord a => a -> a -> Bool
> Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
P.INT
        [] -> forall a. UntangleErr -> Either UntangleErr a
failConversion forall a b. (a -> b) -> a -> b
$ [DeclarationSpecifier] -> UntangleErr
NoDataTypes [DeclarationSpecifier]
declSpecs
        TypeSpecifier
_:[TypeSpecifier]
_ -> forall a. UntangleErr -> Either UntangleErr a
failConversion forall a b. (a -> b) -> a -> b
$ [DeclarationSpecifier] -> UntangleErr
MultipleDataTypes [DeclarationSpecifier]
declSpecs
      -- Check if things are compatible with one another
      let checkNoSpecs :: Either UntangleErr ()
checkNoSpecs =
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeSpecifier]
specs) forall a b. (a -> b) -> a -> b
$ forall {a}. String -> Either UntangleErr a
illegalSpecifiers String
"expecting no specifiers"
      let checkNoLength :: Either UntangleErr ()
checkNoLength =
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
longs forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
shorts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall {a}. String -> Either UntangleErr a
illegalSpecifiers String
"unexpected long/short"
      case TypeSpecifier
dataType of
        P.Template CIdentifier
s [[TypeSpecifier]]
args -> do
          Either UntangleErr ()
checkNoSpecs
          [TypeSpecifier]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[TypeSpecifier]]
args [TypeSpecifier] -> Either UntangleErr TypeSpecifier
type2type
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CIdentifier -> [TypeSpecifier] -> TypeSpecifier
Template CIdentifier
s [TypeSpecifier]
args'
        P.TemplateConst String
s -> do
          Either UntangleErr ()
checkNoSpecs
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> TypeSpecifier
TemplateConst String
s
        P.TemplatePointer TypeSpecifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          TypeSpecifier
s' <- [TypeSpecifier] -> Either UntangleErr TypeSpecifier
type2type [TypeSpecifier
s]
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeSpecifier -> TypeSpecifier
TemplatePointer TypeSpecifier
s'
        P.TypeName CIdentifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CIdentifier -> TypeSpecifier
TypeName CIdentifier
s
        P.Struct CIdentifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CIdentifier -> TypeSpecifier
Struct CIdentifier
s
        P.Enum CIdentifier
s -> do
          Either UntangleErr ()
checkNoSpecs
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CIdentifier -> TypeSpecifier
Enum CIdentifier
s
        TypeSpecifier
P.VOID -> do
          Either UntangleErr ()
checkNoSpecs
          forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
Void
        TypeSpecifier
P.BOOL -> do
          Either UntangleErr ()
checkNoLength
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeSpecifier
Bool
        TypeSpecifier
P.CHAR -> do
          Either UntangleErr ()
checkNoLength
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Sign -> TypeSpecifier
Char Maybe Sign
mbSign
        TypeSpecifier
P.INT | Int
longs forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
shorts forall a. Eq a => a -> a -> Bool
== Int
0 -> do
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
Int Sign
sign
        TypeSpecifier
P.INT | Int
longs forall a. Eq a => a -> a -> Bool
== Int
1 -> do
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
Long Sign
sign
        TypeSpecifier
P.INT | Int
longs forall a. Eq a => a -> a -> Bool
== Int
2 -> do
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
LLong Sign
sign
        TypeSpecifier
P.INT | Int
shorts forall a. Eq a => a -> a -> Bool
== Int
1 -> do
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Sign -> TypeSpecifier
Short Sign
sign
        TypeSpecifier
P.INT -> do
          forall {a}. String -> Either UntangleErr a
illegalSpecifiers String
"too many long/short"
        TypeSpecifier
P.FLOAT -> do
          Either UntangleErr ()
checkNoLength
          forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
Float
        TypeSpecifier
P.DOUBLE -> do
          if Int
longs forall a. Eq a => a -> a -> Bool
== Int
1
            then forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
LDouble
            else do
              Either UntangleErr ()
checkNoLength
              forall (m :: * -> *) a. Monad m => a -> m a
return TypeSpecifier
Double
        TypeSpecifier
_ -> do
          forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"untangleDeclarationSpecifiers impossible: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeSpecifier
dataType

untangleDeclarator
  :: forall i. Type i -> P.Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator :: forall i. Type i -> Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator Type i
ty0 (P.Declarator [Pointer]
ptrs0 DirectDeclarator i
directDecltor) = Type i -> [Pointer] -> Either UntangleErr (i, Type i)
go Type i
ty0 [Pointer]
ptrs0
  where
    go :: Type i -> [P.Pointer] -> Either UntangleErr (i, Type i)
    go :: Type i -> [Pointer] -> Either UntangleErr (i, Type i)
go Type i
ty [] = Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect Type i
ty DirectDeclarator i
directDecltor
    go Type i
ty (P.Pointer [TypeQualifier]
quals : [Pointer]
ptrs) = Type i -> [Pointer] -> Either UntangleErr (i, Type i)
go (forall i. [TypeQualifier] -> Type i -> Type i
Ptr [TypeQualifier]
quals Type i
ty) [Pointer]
ptrs

    goDirect :: Type i -> P.DirectDeclarator i -> Either UntangleErr (i, Type i)
    goDirect :: Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect Type i
ty DirectDeclarator i
direct0 = case DirectDeclarator i
direct0 of
      P.DeclaratorRoot i
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (i
s, Type i
ty)
      P.ArrayOrProto DirectDeclarator i
direct (P.Array ArrayType i
arrayType) ->
        Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect (forall i. ArrayType i -> Type i -> Type i
Array ArrayType i
arrayType Type i
ty) DirectDeclarator i
direct
      P.ArrayOrProto DirectDeclarator i
direct (P.Proto [ParameterDeclaration i]
params) -> do
        [ParameterDeclaration i]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration [ParameterDeclaration i]
params
        Type i -> DirectDeclarator i -> Either UntangleErr (i, Type i)
goDirect (forall i. Type i -> [ParameterDeclaration i] -> Type i
Proto Type i
ty [ParameterDeclaration i]
params') DirectDeclarator i
direct
      P.DeclaratorParens Declarator i
decltor ->
        forall i. Type i -> Declarator i -> Either UntangleErr (i, Type i)
untangleDeclarator Type i
ty Declarator i
decltor

untangleAbstractDeclarator
  :: forall i. Type i -> P.AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator :: forall i.
Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator Type i
ty0 (P.AbstractDeclarator [Pointer]
ptrs0 Maybe (DirectAbstractDeclarator i)
mbDirectDecltor) =
  Type i -> [Pointer] -> Either UntangleErr (Type i)
go Type i
ty0 [Pointer]
ptrs0
  where
    go :: Type i -> [P.Pointer] -> Either UntangleErr (Type i)
    go :: Type i -> [Pointer] -> Either UntangleErr (Type i)
go Type i
ty [] = case Maybe (DirectAbstractDeclarator i)
mbDirectDecltor of
      Maybe (DirectAbstractDeclarator i)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Type i
ty
      Just DirectAbstractDeclarator i
directDecltor -> Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect Type i
ty DirectAbstractDeclarator i
directDecltor
    go Type i
ty (P.Pointer [TypeQualifier]
quals : [Pointer]
ptrs) = Type i -> [Pointer] -> Either UntangleErr (Type i)
go (forall i. [TypeQualifier] -> Type i -> Type i
Ptr [TypeQualifier]
quals Type i
ty) [Pointer]
ptrs

    goDirect :: Type i -> P.DirectAbstractDeclarator i -> Either UntangleErr (Type i)
    goDirect :: Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect Type i
ty DirectAbstractDeclarator i
direct0 = case DirectAbstractDeclarator i
direct0 of
      P.ArrayOrProtoThere DirectAbstractDeclarator i
direct (P.Array ArrayType i
arrayType) ->
        Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect (forall i. ArrayType i -> Type i -> Type i
Array ArrayType i
arrayType Type i
ty) DirectAbstractDeclarator i
direct
      P.ArrayOrProtoThere DirectAbstractDeclarator i
direct (P.Proto [ParameterDeclaration i]
params) -> do
        [ParameterDeclaration i]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration [ParameterDeclaration i]
params
        Type i -> DirectAbstractDeclarator i -> Either UntangleErr (Type i)
goDirect (forall i. Type i -> [ParameterDeclaration i] -> Type i
Proto Type i
ty [ParameterDeclaration i]
params') DirectAbstractDeclarator i
direct
      P.ArrayOrProtoHere (P.Array ArrayType i
arrayType) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i. ArrayType i -> Type i -> Type i
Array ArrayType i
arrayType Type i
ty
      P.ArrayOrProtoHere (P.Proto [ParameterDeclaration i]
params) -> do
        [ParameterDeclaration i]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration [ParameterDeclaration i]
params
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i. Type i -> [ParameterDeclaration i] -> Type i
Proto Type i
ty [ParameterDeclaration i]
params'
      P.AbstractDeclaratorParens AbstractDeclarator i
decltor ->
        forall i.
Type i -> AbstractDeclarator i -> Either UntangleErr (Type i)
untangleAbstractDeclarator Type i
ty AbstractDeclarator i
decltor

------------------------------------------------------------------------
-- Tangling

tangleParameterDeclaration
  :: forall i. ParameterDeclaration i -> P.ParameterDeclaration i
tangleParameterDeclaration :: forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration (ParameterDeclaration Maybe i
mbId Type i
ty00) =
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall i.
[DeclarationSpecifier]
-> DeclaratorOrAbstractDeclarator i -> ParameterDeclaration i
P.ParameterDeclaration forall a b. (a -> b) -> a -> b
$ case Maybe i
mbId of
      Maybe i
Nothing -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall i. AbstractDeclarator i -> DeclaratorOrAbstractDeclarator i
P.IsAbstractDeclarator forall a b. (a -> b) -> a -> b
$ Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty00 forall a. Maybe a
Nothing
      Just i
id' -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall i. Declarator i -> DeclaratorOrAbstractDeclarator i
P.IsDeclarator forall a b. (a -> b) -> a -> b
$ Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty00 forall a b. (a -> b) -> a -> b
$ forall i. i -> DirectDeclarator i
P.DeclaratorRoot i
id'
  where
    goAbstractDirect
      :: Type i -> Maybe (P.DirectAbstractDeclarator i)
      -> ([P.DeclarationSpecifier], P.AbstractDeclarator i)
    goAbstractDirect :: Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty0 Maybe (DirectAbstractDeclarator i)
mbDirect = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [] Maybe (DirectAbstractDeclarator i)
mbDirect)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstract Type i
ty [[TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals] Maybe (DirectAbstractDeclarator i)
mbDirect
      Array ArrayType i
arrType Type i
ty ->
        let arr :: ArrayOrProto i
arr = forall i. ArrayType i -> ArrayOrProto i
P.Array ArrayType i
arrType
        in case Maybe (DirectAbstractDeclarator i)
mbDirect of
          Maybe (DirectAbstractDeclarator i)
Nothing ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i. ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoHere ArrayOrProto i
arr
          Just DirectAbstractDeclarator i
decltor ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i.
DirectAbstractDeclarator i
-> ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoThere DirectAbstractDeclarator i
decltor ArrayOrProto i
arr
      Proto Type i
ty [ParameterDeclaration i]
params ->
        let proto :: ArrayOrProto i
proto = forall i. [ParameterDeclaration i] -> ArrayOrProto i
P.Proto forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration [ParameterDeclaration i]
params
        in case Maybe (DirectAbstractDeclarator i)
mbDirect of
          Maybe (DirectAbstractDeclarator i)
Nothing ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i. ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoHere ArrayOrProto i
proto
          Just DirectAbstractDeclarator i
decltor ->
            Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i.
DirectAbstractDeclarator i
-> ArrayOrProto i -> DirectAbstractDeclarator i
P.ArrayOrProtoThere DirectAbstractDeclarator i
decltor ArrayOrProto i
proto

    goAbstract
      :: Type i -> [P.Pointer] -> Maybe (P.DirectAbstractDeclarator i)
      -> ([P.DeclarationSpecifier], P.AbstractDeclarator i)
    goAbstract :: Type i
-> [Pointer]
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstract Type i
ty0 [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstract Type i
ty ([TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals forall a. a -> [a] -> [a]
: [Pointer]
ptrs) Maybe (DirectAbstractDeclarator i)
mbDirect
      Array{} ->
        Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i. AbstractDeclarator i -> DirectAbstractDeclarator i
P.AbstractDeclaratorParens forall a b. (a -> b) -> a -> b
$
          forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect
      Proto{} ->
        Type i
-> Maybe (DirectAbstractDeclarator i)
-> ([DeclarationSpecifier], AbstractDeclarator i)
goAbstractDirect Type i
ty0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i. AbstractDeclarator i -> DirectAbstractDeclarator i
P.AbstractDeclaratorParens forall a b. (a -> b) -> a -> b
$
          forall i.
[Pointer]
-> Maybe (DirectAbstractDeclarator i) -> AbstractDeclarator i
P.AbstractDeclarator [Pointer]
ptrs Maybe (DirectAbstractDeclarator i)
mbDirect

    goConcreteDirect
      :: Type i -> P.DirectDeclarator i
      -> ([P.DeclarationSpecifier], P.Declarator i)
    goConcreteDirect :: Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty0 DirectDeclarator i
direct = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [] DirectDeclarator i
direct)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> DirectDeclarator i
-> ([DeclarationSpecifier], Declarator i)
goConcrete Type i
ty [[TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals] DirectDeclarator i
direct
      Array ArrayType i
arrType Type i
ty ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty forall a b. (a -> b) -> a -> b
$ forall i.
DirectDeclarator i -> ArrayOrProto i -> DirectDeclarator i
P.ArrayOrProto DirectDeclarator i
direct forall a b. (a -> b) -> a -> b
$ forall i. ArrayType i -> ArrayOrProto i
P.Array ArrayType i
arrType
      Proto Type i
ty [ParameterDeclaration i]
params ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty forall a b. (a -> b) -> a -> b
$ forall i.
DirectDeclarator i -> ArrayOrProto i -> DirectDeclarator i
P.ArrayOrProto DirectDeclarator i
direct forall a b. (a -> b) -> a -> b
$
          forall i. [ParameterDeclaration i] -> ArrayOrProto i
P.Proto forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration [ParameterDeclaration i]
params

    goConcrete
      :: Type i -> [P.Pointer] -> P.DirectDeclarator i
      -> ([P.DeclarationSpecifier], P.Declarator i)
    goConcrete :: Type i
-> [Pointer]
-> DirectDeclarator i
-> ([DeclarationSpecifier], Declarator i)
goConcrete Type i
ty0 [Pointer]
ptrs DirectDeclarator i
direct = case Type i
ty0 of
      TypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec ->
        let declSpecs :: [DeclarationSpecifier]
declSpecs = Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier Specifiers
specifiers TypeSpecifier
tySpec
        in ([DeclarationSpecifier]
declSpecs, forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [Pointer]
ptrs DirectDeclarator i
direct)
      Ptr [TypeQualifier]
tyQuals Type i
ty ->
        Type i
-> [Pointer]
-> DirectDeclarator i
-> ([DeclarationSpecifier], Declarator i)
goConcrete Type i
ty ([TypeQualifier] -> Pointer
P.Pointer [TypeQualifier]
tyQuals forall a. a -> [a] -> [a]
: [Pointer]
ptrs) DirectDeclarator i
direct
      Array{} ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty0 forall a b. (a -> b) -> a -> b
$ forall i. Declarator i -> DirectDeclarator i
P.DeclaratorParens forall a b. (a -> b) -> a -> b
$ forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [Pointer]
ptrs DirectDeclarator i
direct
      Proto{} ->
        Type i
-> DirectDeclarator i -> ([DeclarationSpecifier], Declarator i)
goConcreteDirect Type i
ty0 forall a b. (a -> b) -> a -> b
$ forall i. Declarator i -> DirectDeclarator i
P.DeclaratorParens forall a b. (a -> b) -> a -> b
$ forall i. [Pointer] -> DirectDeclarator i -> Declarator i
P.Declarator [Pointer]
ptrs DirectDeclarator i
direct

tangleTypeSpecifier :: Specifiers -> TypeSpecifier -> [P.DeclarationSpecifier]
tangleTypeSpecifier :: Specifiers -> TypeSpecifier -> [DeclarationSpecifier]
tangleTypeSpecifier (Specifiers [StorageClassSpecifier]
storages [TypeQualifier]
tyQuals [FunctionSpecifier]
funSpecs) TypeSpecifier
tySpec =
  let pTySpecs :: TypeSpecifier -> [TypeSpecifier]
pTySpecs TypeSpecifier
ty = case TypeSpecifier
ty of
        TypeSpecifier
Void -> [TypeSpecifier
P.VOID]
        TypeSpecifier
Bool -> [TypeSpecifier
P.BOOL]
        Char Maybe Sign
Nothing -> [TypeSpecifier
P.CHAR]
        Char (Just Sign
Signed) -> [TypeSpecifier
P.SIGNED, TypeSpecifier
P.CHAR]
        Char (Just Sign
Unsigned) -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.CHAR]
        Short Sign
Signed -> [TypeSpecifier
P.SHORT]
        Short Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.SHORT]
        Int Sign
Signed -> [TypeSpecifier
P.INT]
        Int Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED]
        Long Sign
Signed -> [TypeSpecifier
P.LONG]
        Long Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.LONG]
        LLong Sign
Signed -> [TypeSpecifier
P.LONG, TypeSpecifier
P.LONG]
        LLong Sign
Unsigned -> [TypeSpecifier
P.UNSIGNED, TypeSpecifier
P.LONG, TypeSpecifier
P.LONG]
        TypeSpecifier
Float -> [TypeSpecifier
P.FLOAT]
        TypeSpecifier
Double -> [TypeSpecifier
P.DOUBLE]
        TypeSpecifier
LDouble -> [TypeSpecifier
P.LONG, TypeSpecifier
P.DOUBLE]
        TypeName CIdentifier
s -> [CIdentifier -> TypeSpecifier
P.TypeName CIdentifier
s]
        Struct CIdentifier
s -> [CIdentifier -> TypeSpecifier
P.Struct CIdentifier
s]
        Enum CIdentifier
s -> [CIdentifier -> TypeSpecifier
P.Enum CIdentifier
s]
        Template CIdentifier
s [TypeSpecifier]
types -> [CIdentifier -> [[TypeSpecifier]] -> TypeSpecifier
P.Template CIdentifier
s (forall a b. (a -> b) -> [a] -> [b]
map TypeSpecifier -> [TypeSpecifier]
pTySpecs [TypeSpecifier]
types)]
        TemplateConst String
s -> [String -> TypeSpecifier
P.TemplateConst String
s]
        TemplatePointer TypeSpecifier
type' -> [TypeSpecifier -> TypeSpecifier
P.TemplatePointer (forall a. [a] -> a
head (TypeSpecifier -> [TypeSpecifier]
pTySpecs TypeSpecifier
type'))]
  in forall a b. (a -> b) -> [a] -> [b]
map StorageClassSpecifier -> DeclarationSpecifier
P.StorageClassSpecifier [StorageClassSpecifier]
storages forall a. [a] -> [a] -> [a]
++
     forall a b. (a -> b) -> [a] -> [b]
map TypeQualifier -> DeclarationSpecifier
P.TypeQualifier [TypeQualifier]
tyQuals forall a. [a] -> [a] -> [a]
++
     forall a b. (a -> b) -> [a] -> [b]
map FunctionSpecifier -> DeclarationSpecifier
P.FunctionSpecifier [FunctionSpecifier]
funSpecs forall a. [a] -> [a] -> [a]
++
     forall a b. (a -> b) -> [a] -> [b]
map TypeSpecifier -> DeclarationSpecifier
P.TypeSpecifier (TypeSpecifier -> [TypeSpecifier]
pTySpecs TypeSpecifier
tySpec)

------------------------------------------------------------------------
-- To english

describeParameterDeclaration :: PP.Pretty i => ParameterDeclaration i -> PP.Doc ann
describeParameterDeclaration :: forall i ann. Pretty i => ParameterDeclaration i -> Doc ann
describeParameterDeclaration (ParameterDeclaration Maybe i
mbId Type i
ty) =
  let idDoc :: Doc ann
idDoc = case Maybe i
mbId of
        Maybe i
Nothing -> Doc ann
""
        Just i
id' -> forall a ann. Pretty a => a -> Doc ann
PP.pretty i
id' forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is a "
  in forall {ann}. Doc ann
idDoc forall a. Semigroup a => a -> a -> a
<> forall i ann. Pretty i => Type i -> Doc ann
describeType Type i
ty

describeType :: PP.Pretty i => Type i -> PP.Doc ann
describeType :: forall i ann. Pretty i => Type i -> Doc ann
describeType Type i
ty0 = case Type i
ty0 of
  TypeSpecifier Specifiers
specs TypeSpecifier
tySpec -> forall {ann}. Specifiers -> Doc ann
engSpecs Specifiers
specs forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
PP.pretty TypeSpecifier
tySpec
  Ptr [TypeQualifier]
quals Type i
ty -> forall {ann}. [TypeQualifier] -> Doc ann
engQuals [TypeQualifier]
quals forall a. Semigroup a => a -> a -> a
<> Doc ann
"ptr to" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall i ann. Pretty i => Type i -> Doc ann
describeType Type i
ty
  Array ArrayType i
arrTy Type i
ty -> forall {a} {ann}. Pretty a => ArrayType a -> Doc ann
engArrTy ArrayType i
arrTy forall a. Semigroup a => a -> a -> a
<> Doc ann
"of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall i ann. Pretty i => Type i -> Doc ann
describeType Type i
ty
  Proto Type i
retTy [ParameterDeclaration i]
params ->
     Doc ann
"function from" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {i} {ann}. Pretty i => [ParameterDeclaration i] -> Doc ann
engParams [ParameterDeclaration i]
params forall a. Semigroup a => a -> a -> a
<> Doc ann
"returning" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall i ann. Pretty i => Type i -> Doc ann
describeType Type i
retTy
  where
    engSpecs :: Specifiers -> Doc ann
engSpecs (Specifiers [] [] []) = Doc ann
""
    engSpecs (Specifiers [StorageClassSpecifier]
x [TypeQualifier]
y [FunctionSpecifier]
z) =
      let xs :: [DeclarationSpecifier]
xs = forall a b. (a -> b) -> [a] -> [b]
map StorageClassSpecifier -> DeclarationSpecifier
P.StorageClassSpecifier [StorageClassSpecifier]
x forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map TypeQualifier -> DeclarationSpecifier
P.TypeQualifier [TypeQualifier]
y forall a. [a] -> [a] -> [a]
++
               forall a b. (a -> b) -> [a] -> [b]
map FunctionSpecifier -> DeclarationSpecifier
P.FunctionSpecifier [FunctionSpecifier]
z
      in forall ann. [Doc ann] -> Doc ann
PP.hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
PP.pretty [DeclarationSpecifier]
xs) forall a. Semigroup a => a -> a -> a
<> Doc ann
" "

    engQuals :: [TypeQualifier] -> Doc ann
engQuals = forall ann. [Doc ann] -> Doc ann
PP.hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
PP.pretty

    engArrTy :: ArrayType a -> Doc ann
engArrTy ArrayType a
arrTy = case ArrayType a
arrTy of
      ArrayType a
P.VariablySized -> Doc ann
"variably sized array "
      P.SizedByInteger Integer
n -> Doc ann
"array of size" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Integer
n) forall a. Semigroup a => a -> a -> a
<> Doc ann
" "
      P.SizedByIdentifier a
s -> Doc ann
"array of size" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
PP.pretty a
s forall a. Semigroup a => a -> a -> a
<> Doc ann
" "
      ArrayType a
P.Unsized -> Doc ann
"array "

    engParams :: [ParameterDeclaration i] -> Doc ann
engParams [] = Doc ann
""
    engParams [ParameterDeclaration i]
params0 = Doc ann
"(" forall a. Semigroup a => a -> a -> a
<> forall {i} {ann}. Pretty i => [ParameterDeclaration i] -> Doc ann
go [ParameterDeclaration i]
params0 forall a. Semigroup a => a -> a -> a
<> Doc ann
") "
      where
        go :: [ParameterDeclaration i] -> Doc ann
go [ParameterDeclaration i]
xs = case [ParameterDeclaration i]
xs of
          [] -> Doc ann
""
          [ParameterDeclaration i
x] -> forall i ann. Pretty i => ParameterDeclaration i -> Doc ann
describeParameterDeclaration ParameterDeclaration i
x
          (ParameterDeclaration i
x:[ParameterDeclaration i]
xs') -> forall i ann. Pretty i => ParameterDeclaration i -> Doc ann
describeParameterDeclaration ParameterDeclaration i
x forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall ann. Doc ann -> Doc ann -> Doc ann
<+> [ParameterDeclaration i] -> Doc ann
go [ParameterDeclaration i]
xs'

------------------------------------------------------------------------
-- Convenient parsing

untangleParameterDeclaration'
  :: (P.CParser i m, PP.Pretty i)
  => P.ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' :: forall i (m :: * -> *).
(CParser i m, Pretty i) =>
ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' ParameterDeclaration i
pDecl =
  case forall i.
ParameterDeclaration i
-> Either UntangleErr (ParameterDeclaration i)
untangleParameterDeclaration ParameterDeclaration i
pDecl of
    Left UntangleErr
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> String
pretty80 forall a b. (a -> b) -> a -> b
$
      forall ann. [Doc ann] -> Doc ann
PP.vsep [Doc Any
"Error while parsing declaration:", forall a ann. Pretty a => a -> Doc ann
PP.pretty UntangleErr
err, forall a ann. Pretty a => a -> Doc ann
PP.pretty ParameterDeclaration i
pDecl]
    Right ParameterDeclaration i
x -> forall (m :: * -> *) a. Monad m => a -> m a
return ParameterDeclaration i
x

parseParameterDeclaration
  :: (P.CParser i m, PP.Pretty i) => m (ParameterDeclaration i)
parseParameterDeclaration :: forall i (m :: * -> *).
(CParser i m, Pretty i) =>
m (ParameterDeclaration i)
parseParameterDeclaration =
  forall i (m :: * -> *).
(CParser i m, Pretty i) =>
ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall i (m :: * -> *). CParser i m => m (ParameterDeclaration i)
P.parameter_declaration

parseParameterList
  :: (P.CParser i m, PP.Pretty i)
  => m [ParameterDeclaration i]
parseParameterList :: forall i (m :: * -> *).
(CParser i m, Pretty i) =>
m [ParameterDeclaration i]
parseParameterList =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i (m :: * -> *).
(CParser i m, Pretty i) =>
ParameterDeclaration i -> m (ParameterDeclaration i)
untangleParameterDeclaration' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall i (m :: * -> *). CParser i m => m [ParameterDeclaration i]
P.parameter_list

parseIdentifier :: P.CParser i m => m i
parseIdentifier :: forall i (m :: * -> *). CParser i m => m i
parseIdentifier = forall i (m :: * -> *). CParser i m => m i
P.identifier_no_lex

parseEnableCpp :: P.CParser i m => m Bool
parseEnableCpp :: forall i (m :: * -> *). CParser i m => m Bool
parseEnableCpp = do
  CParserContext i
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall i. CParserContext i -> Bool
P.cpcEnableCpp CParserContext i
ctx)

parseType :: (P.CParser i m, PP.Pretty i) => m (Type i)
parseType :: forall i (m :: * -> *). (CParser i m, Pretty i) => m (Type i)
parseType = forall i. ParameterDeclaration i -> Type i
parameterDeclarationType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (m :: * -> *).
(CParser i m, Pretty i) =>
m (ParameterDeclaration i)
parseParameterDeclaration

------------------------------------------------------------------------
-- Pretty

instance PP.Pretty TypeSpecifier where
  pretty :: forall ann. TypeSpecifier -> Doc ann
pretty TypeSpecifier
tySpec = case TypeSpecifier
tySpec of
    TypeSpecifier
Void -> Doc ann
"void"
    TypeSpecifier
Bool -> Doc ann
"bool"
    Char Maybe Sign
Nothing -> Doc ann
"char"
    Char (Just Sign
Signed) -> Doc ann
"signed char"
    Char (Just Sign
Unsigned) -> Doc ann
"unsigned char"
    Short Sign
Signed -> Doc ann
"short"
    Short Sign
Unsigned -> Doc ann
"unsigned short"
    Int Sign
Signed -> Doc ann
"int"
    Int Sign
Unsigned -> Doc ann
"unsigned"
    Long Sign
Signed -> Doc ann
"long"
    Long Sign
Unsigned -> Doc ann
"unsigned long"
    LLong Sign
Signed -> Doc ann
"long long"
    LLong Sign
Unsigned -> Doc ann
"unsigned long long"
    TypeSpecifier
Float -> Doc ann
"float"
    TypeSpecifier
Double -> Doc ann
"double"
    TypeSpecifier
LDouble -> Doc ann
"long double"
    TypeName CIdentifier
s -> forall a ann. Pretty a => a -> Doc ann
PP.pretty CIdentifier
s
    Struct CIdentifier
s -> Doc ann
"struct" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
PP.pretty CIdentifier
s
    Enum CIdentifier
s -> Doc ann
"enum" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
PP.pretty CIdentifier
s
    Template CIdentifier
s [TypeSpecifier]
args -> forall a ann. Pretty a => a -> Doc ann
PP.pretty CIdentifier
s forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<"  forall ann. Doc ann -> Doc ann -> Doc ann
<+>  forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Doc ann
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
PP.pretty [TypeSpecifier]
args))  forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
">"
    TemplateConst String
s -> forall a ann. Pretty a => a -> Doc ann
PP.pretty String
s
    TemplatePointer TypeSpecifier
s -> forall a ann. Pretty a => a -> Doc ann
PP.pretty TypeSpecifier
s forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"*"

instance PP.Pretty UntangleErr where
  pretty :: forall ann. UntangleErr -> Doc ann
pretty UntangleErr
err = case UntangleErr
err of
    MultipleDataTypes [DeclarationSpecifier]
specs ->
      forall ann. [Doc ann] -> Doc ann
PP.vsep [Doc ann
"Multiple data types in", forall a ann. Pretty a => [a] -> Doc ann
PP.prettyList [DeclarationSpecifier]
specs]
    IllegalSpecifiers String
s [TypeSpecifier]
specs ->
      forall ann. [Doc ann] -> Doc ann
PP.vsep [Doc ann
"Illegal specifiers," forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. IsString a => String -> a
fromString String
s forall a. Semigroup a => a -> a -> a
<> Doc ann
", in", forall a ann. Pretty a => [a] -> Doc ann
PP.prettyList [TypeSpecifier]
specs]
    NoDataTypes [DeclarationSpecifier]
specs ->
      forall ann. [Doc ann] -> Doc ann
PP.vsep [Doc ann
"No data types in", forall a ann. Pretty a => [a] -> Doc ann
PP.prettyList [DeclarationSpecifier]
specs]

instance PP.Pretty i => PP.Pretty (ParameterDeclaration i) where
  pretty :: forall ann. ParameterDeclaration i -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
PP.pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration

instance PP.Pretty i => PP.Pretty (Type i) where
  pretty :: forall ann. Type i -> Doc ann
pretty Type i
ty =
    forall a ann. Pretty a => a -> Doc ann
PP.pretty forall a b. (a -> b) -> a -> b
$ forall i. ParameterDeclaration i -> ParameterDeclaration i
tangleParameterDeclaration forall a b. (a -> b) -> a -> b
$ forall i. Maybe i -> Type i -> ParameterDeclaration i
ParameterDeclaration forall a. Maybe a
Nothing Type i
ty

------------------------------------------------------------------------
-- Utils

pretty80 :: PP.Doc ann -> String
pretty80 :: forall ann. Doc ann -> String
pretty80 Doc ann
x = forall ann. SimpleDocStream ann -> String
PP.renderString forall a b. (a -> b) -> a -> b
$ forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PP.layoutSmart (PP.LayoutOptions { layoutPageWidth :: PageWidth
PP.layoutPageWidth = Int -> Double -> PageWidth
PP.AvailablePerLine Int
80 Double
0.8 }) Doc ann
x