    -- 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 :: TranslationUnit -> Either String [String]
    cstructs2CopilotDecls (C.MkTranslationUnit [ExternalDeclaration]
    gs) =
      [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String])
    -> Either String [[String]] -> Either String [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExternalDeclaration -> Either String [String])
    -> [ExternalDeclaration] -> Either String [[String]]
    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 ((CStruct -> [String])
    -> Either String CStruct -> Either String [String]
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CStruct -> [String]
    cstruct2CopilotDecls  (Either String CStruct -> Either String [String])
    -> (ExternalDeclaration -> Either String CStruct)
    -> ExternalDeclaration
    -> Either String [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExternalDeclaration -> Either String CStruct
    mkCStruct) [ExternalDeclaration]
    gs

    -- | Convert a 'CStruct' into the declarations needed in Copilot to use it.
    cstruct2CopilotDecls :: CStruct -> [ String ]
    cstruct2CopilotDecls :: CStruct -> [String]
    cstruct2CopilotDecls CStruct
    cstruct = [ CStruct -> String
    cStructToCopilotStruct CStruct
    cstruct
                                   , CStruct -> String
    structInstance         CStruct
    cstruct
                                   , CStruct -> String
    typedInstance          CStruct
    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 -> String
    cStructToCopilotStruct CStruct
    cstruct = [String] -> String
    unlines
        [ String
    "data " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    datatype String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    constructor
        , String
    "   deriving Generic"
        ]
      where

        -- The name of the type (e.g., @AStruct@).
        datatype :: String
    datatype = String -> String
    cStructName2Haskell (CStruct -> String
    cStructName CStruct
    cstruct)

        -- The name of the constructor (e.g., @AStruct@).
        constructor :: String
    constructor = String -> String
    cStructName2Haskell (CStruct -> String
    cStructName CStruct
    cstruct) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    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 :: String
    fields = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
                         ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ([String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "}"])
                         ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a. (a -> a) -> [a] -> [a]
    toTail (String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
                         ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a. (a -> a) -> [a] -> [a]
    toHead (String
    "{ " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
                         ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (CField -> String) -> [CField] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (CStruct -> CField -> String
    toField CStruct
    cstruct) (CStruct -> [CField]
    cStructFields CStruct
    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 -> CField -> String
    toField CStruct
    cstruct' (CPlain String
    t String
    n) = String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " :: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ty
          where
            name :: String
    name = CStruct -> String -> String
    fieldName CStruct
    cstruct' String
    n
            ty :: String
    ty   = String
    "Field" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    n
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cTypeName2HaskellType String
    t

        toField CStruct
    cstruct' (CArray String
    t String
    n Integer
    l) = String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " :: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ty
          where
            name :: String
    name = CStruct -> String -> String
    fieldName CStruct
    cstruct' String
    n
            ty :: String
    ty   = String
    "Field" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    n
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Array"
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    l
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cTypeName2HaskellType String
    t
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    -- | 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 -> String
    structInstance CStruct
    cstruct = [String] -> String
    unlines
        [ String
    "instance Struct " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    instanceName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " where"
        , String
    "  typeName = typeNameDefault"
        , String
    "  toValues = toValuesDefault"
        ]
      where
        instanceName :: String
    instanceName = String -> String
    cStructName2Haskell (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ CStruct -> String
    cStructName CStruct
    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 -> String
    typedInstance CStruct
    cstruct = [String] -> String
    unlines
        [ String
    "instance Typed " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    instanceName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " where"
        , String
    "  typeOf = typeOfDefault"
        ]
      where
        instanceName :: String
    instanceName = String -> String
    cStructName2Haskell (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ CStruct -> String
    cStructName CStruct
    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 -> String -> String
    fieldName CStruct
    cstruct String
    n =
        String -> String
    summary (String -> String
    cStructName2Haskell (CStruct -> String
    cStructName CStruct
    cstruct)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cStructName2Haskell String
    n
      where
        summary :: String -> String
        summary :: String -> String
    summary = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter Char -> Bool
    isUpper

    -- | Convert a C struct name (e.g., @some_type_t@) to a Haskell type name
    -- (e.g., @SomeType@).
    cStructName2Haskell :: String -> String
    cStructName2Haskell :: String -> String
    cStructName2Haskell = String -> String
    camelCaseTypeName

    -- | Return the corresponding type in Copilot/Haskell for a given type.
    cTypeName2HaskellType :: String -> String
    cTypeName2HaskellType :: String -> String
    cTypeName2HaskellType String
    "float"    = String
    "Float"
    cTypeName2HaskellType String
    "double"   = String
    "Double"
    cTypeName2HaskellType String
    "int"      = String
    "Int"
    cTypeName2HaskellType String
    "uint8_t"  = String
    "Word8"
    cTypeName2HaskellType String
    "uint16_t" = String
    "Word16"
    cTypeName2HaskellType String
    "uint32_t" = String
    "Word32"
    cTypeName2HaskellType String
    "uint64_t" = String
    "Word64"
    cTypeName2HaskellType String
    "int8_t"   = String
    "Int8"
    cTypeName2HaskellType String
    "int16_t"  = String
    "Int16"
    cTypeName2HaskellType String
    "int32_t"  = String
    "Int32"
    cTypeName2HaskellType String
    "int64_t"  = String
    "Int64"
    cTypeName2HaskellType String
    "bool"     = String
    "Bool"
    cTypeName2HaskellType String
    t          = String -> String
    camelCaseTypeName String
    t