content: -- Copyright 2020 United States Government as represented by the Administrator
  -- of the National Aeronautics and Space Administration. All Rights Reserved.
  --
  -- Disclaimers
  --
  -- Licensed under the Apache License, Version 2.0 (the "License"); you may
  -- not use this file except in compliance with the License. You may obtain a
  -- copy of the License at
  --
  --      https://www.apache.org/licenses/LICENSE-2.0
  --
  -- Unless required by applicable law or agreed to in writing, software
  -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
  -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
  -- License for the specific language governing permissions and limitations
  -- under the License.
  --
  -- | Generate Copilot struct definitions and instances from structs defined in
  -- a C header file.
  --
  -- Working with Copilot structs requires three definitions: the datatype,
  -- a @Struct@ instance, and a @Typed@ instance.
  --
  -- This module converts the C structs into 'CStruct's, and then converts
  -- those 'CStruct's into Copilot (i.e., Haskell) data type declarations and
  -- instance declarations represented as strings.
  module Language.Trans.CStructs2Copilot where
  
  -- External imports
  import Data.Char ( isUpper, toLower )
  import Data.List ( intercalate )
  
  -- External imports: auxiliary
  import Data.List.Extra ( toHead, toTail )
  
  -- Internal imports: C AST
  import qualified Language.C.AbsC          as C
  import           Language.Copilot.CStruct ( CField (CArray, CPlain),
                                              CStruct (..) )
  
  -- Internal imports: Copilot's representation of C structs
  import Language.Trans.CStruct2CopilotStruct ( camelCaseTypeName, mkCStruct )
  
  -- | Convert all the 'CStruct's in a header file into the declarations needed
  -- in Copilot to use it.
  cstructs2CopilotDecls :: C.TranslationUnit -> Either String [ String ]
  cstructs2CopilotDecls (C.MkTranslationUnit gs) =
    concat <$> mapM (fmap cstruct2CopilotDecls  . mkCStruct) gs
  
  -- | Convert a 'CStruct' into the declarations needed in Copilot to use it.
  cstruct2CopilotDecls :: CStruct -> [ String ]
  cstruct2CopilotDecls cstruct = [ cStructToCopilotStruct cstruct
                                 , structInstance         cstruct
                                 , typedInstance          cstruct
                                 ]
  
  -- ** Individual conversions
  
  -- | Convert a 'CStruct' definition into a Copilot Struct declaration.
  --
  -- For example, given the struct generated by the following definition:
  --
  -- @
  --   struct {
  --     uint8_t f1;
  --   } a_struct_t;
  -- @
  --
  -- the corresponding Haskell definition would be:
  --
  -- @
  -- data AStruct = AStruct
  --     { aSF1 :: Word8 }
  --   deriving Generic
  -- @
  cStructToCopilotStruct :: CStruct -> String
  cStructToCopilotStruct cstruct = unlines
      [ "data " ++ datatype ++ " = " ++ constructor
      , "   deriving Generic"
      ]
    where
  
      -- The name of the type (e.g., @AStruct@).
      datatype = cStructName2Haskell (cStructName cstruct)
  
      -- The name of the constructor (e.g., @AStruct@).
      constructor = cStructName2Haskell (cStructName cstruct) ++ "\n" ++ fields
  
      -- The fields in the struct (e.g., @aSF1 :: Word 8@), formated as record
      -- fields: separated by commas, enclosed in curly brackets, and indented.
      fields = unlines $ map ("  " ++)
                       $ (++ ["}"])
                       $ toTail (", " ++)
                       $ toHead ("{ " ++)
                       $ map (toField cstruct) (cStructFields cstruct)
  
      -- Convert a 'CStruct' field into a Copilot record field declaration.
      --
      -- The second case (@CArray@) uses depedent types to promote the length of
      -- the array to type level.
      toField :: CStruct -> CField -> String
      toField cstruct' (CPlain t n) = name ++ " :: " ++ ty
        where
          name = fieldName cstruct' n
          ty   = "Field" ++ " " ++ show n
                         ++ " " ++ cTypeName2HaskellType t
  
      toField cstruct' (CArray t n l) = name ++ " :: " ++ ty
        where
          name = fieldName cstruct' n
          ty   = "Field" ++ " " ++ show n
                         ++ " (" ++ "Array"
                         ++ " " ++ show l
                         ++ " " ++ cTypeName2HaskellType t
                         ++ ")"
  
  -- | Convert a 'CStruct' definition into a Copilot @Struct@ instance
  -- declaration. For example, for the struct:
  --
  -- @
  --   struct {
  --     uint8_t f1;
  --   } a_struct_t;
  -- @
  --
  -- the corresponding @Struct@ instance would be:
  --
  -- @
  --   instance Struct AStruct where
  --     typeName = typeNameDefault
  --     toValues = toValuesDefault
  -- @
  structInstance :: CStruct -> String
  structInstance cstruct = unlines
      [ "instance Struct " ++ instanceName ++ " where"
      , "  typeName = typeNameDefault"
      , "  toValues = toValuesDefault"
      ]
    where
      instanceName = cStructName2Haskell $ cStructName cstruct
  
  -- | Convert a 'CStruct' definition to Copilot @Typed@ instance declaration.
  -- For example, for the struct:
  --
  -- @
  --   struct {
  --     uint8_t f1;
  --   } a_struct_t;
  -- @
  --
  -- the corresponding @Typed@ instance could be:
  --
  -- @
  --   instance Typed AStruct where
  --     typeOf = typeOfDefault
  -- @
  typedInstance :: CStruct -> String
  typedInstance cstruct = unlines
      [ "instance Typed " ++ instanceName ++ " where"
      , "  typeOf = typeOfDefault"
      ]
    where
      instanceName = cStructName2Haskell $ cStructName cstruct
  
  -- * Auxiliary functions
  
  -- | Provide a suitable field name for a record field of a 'CStruct' in Haskell.
  --
  -- For example, given the struct:
  --
  -- @
  --   struct {
  --     uint8_t f1;
  --   } a_struct_t;
  -- @
  --
  -- the field name in the Haskell record would be @aSF1@, where the @aS@ and
  -- comes from @a_struct_t@ and the final @F1@ comes from @f1@.
  fieldName :: CStruct -> String -> String
  fieldName cstruct n =
      summary (cStructName2Haskell (cStructName cstruct)) ++ cStructName2Haskell n
    where
      summary :: String -> String
      summary = map toLower . filter isUpper
  
  -- | Convert a C struct name (e.g., @some_type_t@) to a Haskell type name
  -- (e.g., @SomeType@).
  cStructName2Haskell :: String -> String
  cStructName2Haskell = camelCaseTypeName
  
  -- | Return the corresponding type in Copilot/Haskell for a given type.
  cTypeName2HaskellType :: String -> String
  cTypeName2HaskellType "float"    = "Float"
  cTypeName2HaskellType "double"   = "Double"
  cTypeName2HaskellType "int"      = "Int"
  cTypeName2HaskellType "uint8_t"  = "Word8"
  cTypeName2HaskellType "uint16_t" = "Word16"
  cTypeName2HaskellType "uint32_t" = "Word32"
  cTypeName2HaskellType "uint64_t" = "Word64"
  cTypeName2HaskellType "int8_t"   = "Int8"
  cTypeName2HaskellType "int16_t"  = "Int16"
  cTypeName2HaskellType "int32_t"  = "Int32"
  cTypeName2HaskellType "int64_t"  = "Int64"
  cTypeName2HaskellType "bool"     = "Bool"
  cTypeName2HaskellType t          = camelCaseTypeName t
  