module Main
    ( main
    ) where

import Language.Elna.Object.Elf
    ( ByteOrder(..)
    , Elf32_Ehdr(..)
    , Elf32_Off
    , ElfMachine(..)
    , ElfType(..)
    , ElfVersion(..)
    , ElfIdentification(..)
    , ElfClass(..)
    , ElfData(..)
    , Elf32_Shdr(..)
    , ElfSectionType(..)
    , elf32Ehdr
    , elf32Shdr
    )
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Control.Exception (throwIO)
import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
import Data.Foldable (traverse_)

riscv32Elf :: FilePath -> IO ()
riscv32Elf outFile = withFile outFile WriteMode withObjectFile
  where
    headerSize :: Elf32_Off
    headerSize = 52
    withObjectFile objectHandle
        = hSeek objectHandle AbsoluteSeek (fromIntegral headerSize)
        >> putContents objectHandle
        >>= afterContents objectHandle
    afterContents objectHandle headers =
        let headerEncodingResult = elf32Ehdr
                $ header
                $ Vector.foldr ((+) . sh_size) 0 headers
         in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
            >> either throwIO (putHeaders objectHandle) headerEncodingResult
    putHeaders objectHandle encodedHeader
        = hSeek objectHandle AbsoluteSeek 0
        >> ByteString.Builder.hPutBuilder objectHandle encodedHeader
    putContents :: Handle -> IO (Vector Elf32_Shdr)
    putContents objectHandle =
        let stringTable = "\0shstrtab\0"
            written = Vector.fromList
                [ Elf32_Shdr
                    { sh_type = SHT_NULL
                    , sh_size = 0
                    , sh_offset = 0
                    , sh_name = 0
                    , sh_link = 0
                    , sh_info = 0
                    , sh_flags = 0
                    , sh_entsize = 0
                    , sh_addralign = 0
                    , sh_addr = 0
                    }
                , Elf32_Shdr
                    { sh_type = SHT_STRTAB
                    , sh_size = fromIntegral $ ByteString.length stringTable
                    , sh_offset = fromIntegral headerSize
                    , sh_name = 1
                    , sh_link = 0
                    , sh_info = 0
                    , sh_flags = 0
                    , sh_entsize = 0
                    , sh_addralign = 0
                    , sh_addr = 0
                    }
                ]
         in ByteString.hPut objectHandle stringTable
            >> pure written
    header written = Elf32_Ehdr
        { e_version = EV_CURRENT
        , e_type = ET_REL
        , e_shstrndx = 1 -- String table. SHN_UNDEF
        , e_shoff = written + headerSize
        , e_shnum = 2
        , e_shentsize = 40
        , e_phoff = 0
        , e_phnum = 0
        , e_phentsize = 32
        , e_machine = EM_RISCV
        , e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
        , e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
        , e_entry = 0
        , e_ehsize = fromIntegral headerSize
        }

main :: IO ()
main = riscv32Elf "here.o"