-- Copyright 2020 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- Disclaimers
--
-- No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY WARRANTY
-- OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT
-- LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO
-- SPECIFICATIONS, ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
-- PARTICULAR PURPOSE, OR FREEDOM FROM INFRINGEMENT, ANY WARRANTY THAT THE
-- SUBJECT SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY THAT DOCUMENTATION, IF
-- PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN
-- ANY MANNER, CONSTITUTE AN ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR
-- RECIPIENT OF ANY RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR
-- ANY OTHER APPLICATIONS RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER,
-- GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING
-- THIRD-PARTY SOFTWARE, IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES
-- IT "AS IS."
--
-- Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS AGAINST
-- THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS
-- ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN
-- ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR LOSSES ARISING FROM SUCH USE,
-- INCLUDING ANY DAMAGES FROM PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S
-- USE OF THE SUBJECT SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE
-- UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY
-- PRIOR RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY
-- FOR ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS
-- AGREEMENT.
--
-- | Copilot's struct representation of C Structs and creation from C's AST.
module Language.Trans.CStruct2CopilotStruct
    (
      -- * Constructors
      mkCStruct

      -- * Convert C type names to valid Copilot names
    , camelCaseTypeName
    )
  where

-- External imports
import Data.Char ( toUpper )

-- External imports: Copilot C Struct representation
import Language.Copilot.CStruct ( CField (CArray, CPlain), CStruct(..) )

-- Internal imports
import qualified Language.C.AbsC as C

-- | Convert a top-level struct declaration into a CStruct
mkCStruct :: C.ExternalDeclaration -> Either String CStruct
mkCStruct :: ExternalDeclaration -> Either String CStruct
mkCStruct (C.MkExternalDeclarationFunctionDefinition FunctionDefinition
_) = String -> Either String CStruct
forall a b. a -> Either a b
Left String
"C files must contain struct definitions only."
mkCStruct (C.MkExternalDeclarationDeclaration (C.MkDeclaration DeclarationSpecifiers
specifiers InitDeclarationListOpt
initDecl)) =
  case DeclarationSpecifiers
specifiers of
    C.DeclarationSpecifiers (C.MkDeclarationSpecifierStorageClass StorageClassSpecifier
C.MkStorageClassSpecifierTypedef) [DeclarationSpecifier]
s ->
      let [C.MkDeclarationSpecifierTypeSpecifier (C.MkTypeSpecifierStructOrUnion (C.MkStructOrUnionSpecifierWithFields StructOrUnion
C.MkStructOrUnionStruct IdentifierOpt
_structName [StructDeclaration]
u))] = [DeclarationSpecifier]
s
          (C.MkInitDeclarationListOptJust [C.MkInitDeclaratorUninitialized (C.MkDeclarator PointerOpt
C.MkPointerOptNothing (C.MkDirectDeclaratorIdentifier (C.Identifier String
t)))]) = InitDeclarationListOpt
initDecl
          name :: Either a String
name = String -> Either a String
forall a b. b -> Either a b
Right String
t
          fields :: Either String [CField]
fields = (StructDeclaration -> Either String CField)
-> [StructDeclaration] -> Either String [CField]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM StructDeclaration -> Either String CField
buildCField [StructDeclaration]
u
      in String -> [CField] -> CStruct
CStruct (String -> [CField] -> CStruct)
-> Either String String -> Either String ([CField] -> CStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String String
forall {a}. Either a String
name Either String ([CField] -> CStruct)
-> Either String [CField] -> Either String CStruct
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String [CField]
fields
    DeclarationSpecifiers
_ -> String -> Either String CStruct
forall a b. a -> Either a b
Left String
"C files must contain struct definitions only."

-- -- | Convert a declaration within a struct into a field declaration.
buildCField :: C.StructDeclaration -> Either String CField
buildCField :: StructDeclaration -> Either String CField
buildCField (C.MkStructDeclaration [SpecifierQualifier]
field [StructDeclarator]
name)
    | Integer
fieldLength Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = String -> String -> Integer -> CField
CArray (String -> String -> Integer -> CField)
-> Either String String
-> Either String (String -> Integer -> CField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String String
fieldType Either String (String -> Integer -> CField)
-> Either String String -> Either String (Integer -> CField)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String String
fieldName Either String (Integer -> CField)
-> Either String Integer -> Either String CField
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Either String Integer
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
fieldLength
    | Bool
otherwise       = String -> String -> CField
CPlain (String -> String -> CField)
-> Either String String -> Either String (String -> CField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String String
fieldType Either String (String -> CField)
-> Either String String -> Either String CField
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String String
fieldName
  where
    fieldType :: Either String String
fieldType   = SpecifierQualifier -> Either String String
extractFieldType ([SpecifierQualifier] -> SpecifierQualifier
forall a. HasCallStack => [a] -> a
head [SpecifierQualifier]
field)
    fieldName :: Either String String
fieldName   = StructDeclarator -> Either String String
forall n. Read n => StructDeclarator -> Either String n
extractFieldName ([StructDeclarator] -> StructDeclarator
forall a. HasCallStack => [a] -> a
head [StructDeclarator]
name)
    fieldLength :: Integer
fieldLength = StructDeclarator -> Integer
extractFieldLength ([StructDeclarator] -> StructDeclarator
forall a. HasCallStack => [a] -> a
head [StructDeclarator]
name)

-- | Extract the type of a field from a type specification.
extractFieldType :: C.SpecifierQualifier -> Either String String
extractFieldType :: SpecifierQualifier -> Either String String
extractFieldType (C.MkSpecifierQualifierTypeSpecifier TypeSpecifier
t) = String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ TypeSpecifier -> String
showTypeSpecifier TypeSpecifier
t
extractFieldType (C.MkSpecifierQualifierTypeQualifier TypeQualifier
_) = String -> Either String String
forall a b. a -> Either a b
Left String
"type qualifiers."

-- | String representing a known type.
showTypeSpecifier :: C.TypeSpecifier -> String
showTypeSpecifier :: TypeSpecifier -> String
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierFloat  = String
"float"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierDouble = String
"double"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt8  = String
"uint8_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt16 = String
"uint16_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt32 = String
"uint32_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierUInt64 = String
"uint64_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt8   = String
"int8_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt16  = String
"int16_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt32  = String
"int32_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt64  = String
"int64_t"
showTypeSpecifier TypeSpecifier
C.MkTypeSpecifierInt    = String
"int"

-- -- | Extract the name of a field from a struct declarator.
extractFieldName :: Read n => C.StructDeclarator -> Either String n
extractFieldName :: forall n. Read n => StructDeclarator -> Either String n
extractFieldName (C.MkStructDeclaratorDeclarator (C.MkDeclarator PointerOpt
C.MkPointerOptNothing (C.MkDirectDeclaratorIdentifier (C.Identifier String
d)))) = n -> Either String n
forall a b. b -> Either a b
Right (n -> Either String n) -> n -> Either String n
forall a b. (a -> b) -> a -> b
$ String -> n
forall a. Read a => String -> a
read (String -> n) -> String -> n
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
d
extractFieldName (C.MkStructDeclaratorDeclarator
                    (C.MkDeclarator
                      PointerOpt
C.MkPointerOptNothing
                      (C.MkDirectDeclaratorConstantExpressionOpt
                         (C.MkDirectDeclaratorIdentifier (C.Identifier String
i))
                         ConstantExpressionOpt
_arrayLength
                      )
                    )
                  ) = n -> Either String n
forall a b. b -> Either a b
Right (n -> Either String n) -> n -> Either String n
forall a b. (a -> b) -> a -> b
$ String -> n
forall a. Read a => String -> a
read (String -> n) -> String -> n
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
i
extractFieldName StructDeclarator
_ = String -> Either String n
forall a b. a -> Either a b
Left (String -> Either String n) -> String -> Either String n
forall a b. (a -> b) -> a -> b
$ String
"only struct declarations that are IDs without a"
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" pointer, or plain arrays without a pointer, are"
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" supported."
--
-- -- | Extract the length of an array field from a struct declarator.
extractFieldLength :: C.StructDeclarator -> Integer
extractFieldLength :: StructDeclarator -> Integer
extractFieldLength (C.MkStructDeclaratorDeclarator
                     (C.MkDeclarator
                       PointerOpt
C.MkPointerOptNothing
                       (C.MkDirectDeclaratorConstantExpressionOpt
                          DirectDeclarator
_varIdent
                          (C.MkConditionalExpressionJust
                            (C.MkConstantExpression
                              (C.Expression12
                                (C.MkCastExpression1
                                   (C.MkUnaryExpressionPostfix
                                      (C.MkPostfixExpression1
                                         (C.MkPrimaryExpressionIdentifier (C.Identifier String
_n))
                                      )
                                   )
                                )
                              )
                            )
                          )
                       )
                     ) ) = Integer
99
extractFieldLength (C.MkStructDeclaratorDeclarator
                     (C.MkDeclarator
                       PointerOpt
C.MkPointerOptNothing
                       (C.MkDirectDeclaratorConstantExpressionOpt
                         DirectDeclarator
_varIdent
                         (C.MkConditionalExpressionJust
                           (C.MkConstantExpression
                             (C.Expression12
                               (C.MkCastExpression1
                                  (C.MkUnaryExpressionPostfix
                                     (C.MkPostfixExpression1
                                       (C.MkPrimaryExpressionConstant (C.MkConstantInteger (C.IntegerConstant String
i))
                                     )
                                   )
                                 )
                               )
                             )
                           )
                         )
                       )
                     )
                   ) = String -> Integer
forall a. Read a => String -> a
read String
i
extractFieldLength StructDeclarator
_ = Integer
0

--
-- | Convert a 'String' to camel case, also eliminating the @_t@ at the end if
-- present.
camelCaseTypeName :: String -> String
camelCaseTypeName :: String -> String
camelCaseTypeName []     = []
camelCaseTypeName (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCaseTypeName' String
xs
  where
    camelCaseTypeName' :: String -> String
    camelCaseTypeName' :: String -> String
camelCaseTypeName' []   = []
    camelCaseTypeName' String
"_t" = []
    camelCaseTypeName' (Char
'_':Char
y:String
ys) = Char -> Char
toUpper Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCaseTypeName' String
ys
    camelCaseTypeName' (Char
y:String
ys) = Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCaseTypeName' String
ys