{-# LANGUAGE TupleSections #-}
module Main where

import System.Directory (doesDirectoryExist, doesFileExist,
                         getDirectoryContents)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import System.Environment
import System.IO
import Data.Bits

importFile :: FilePath -> IO (Maybe (FilePath, LBS.ByteString))
importFile fn = do
    exists <- doesFileExist fn
    if exists
        then Just . (fn,) <$> LBS.readFile fn
        else return Nothing

main = do
    args <- getArgs
    let files = args
    fileInfo <- catMaybes <$> mapM importFile files

    withFile "embedded-files.c" WriteMode $ \fh -> do
        hPutStrLn fh "#include \"embedded-files.h\""
        hPutStrLn fh ""

        hPutStrLn fh $ "static size_t num_embedded_files = " ++ show (length fileInfo) ++ ";"
        hPutStrLn fh ""

        hPutStrLn fh "static const char *embedded_file_names[] = {"
        forM_ fileInfo $ \(fn, _) -> do
            hPutStrLn fh $ "\t\t" ++ show fn ++ ","
        hPutStrLn fh "\t\t0"
        hPutStrLn fh "\t};"
        hPutStrLn fh ""

        hPutStrLn fh "static const char *embedded_file_contents[] = {"
        forM_ fileInfo $ \(_, contents) -> do
            hPutStr fh "\t\t\""
            hPutStr fh . concat . map hexByte . LBS.unpack $ contents
            hPutStrLn fh "\","
        hPutStrLn fh "\t\t0"
        hPutStrLn fh "\t};"
        hPutStrLn fh ""

        hPutStrLn fh "static size_t embedded_file_sizes[] = {"
        forM_ fileInfo $ \(_, contents) -> do
            hPutStr fh "\t\t"
            hPutStr fh . show . LBS.length $ contents
            hPutStrLn fh ","
        hPutStrLn fh "\t\t0"
        hPutStrLn fh "\t};"
        hPutStrLn fh ""

        hPutStrLn fh "size_t get_num_embedded_files() { return num_embedded_files; }"
        hPutStrLn fh ""

        hPutStrLn fh "const char* get_embedded_file_name(size_t index) {"
        hPutStrLn fh "\tif (index >= num_embedded_files) return 0;"
        hPutStrLn fh "\treturn embedded_file_names[index];"
        hPutStrLn fh "}"
        hPutStrLn fh ""
        hPutStrLn fh "size_t get_embedded_file_content_size(size_t index) {"
        hPutStrLn fh "\tif (index >= num_embedded_files) return 0;"
        hPutStrLn fh "\treturn embedded_file_sizes[index];"
        hPutStrLn fh "}"
        hPutStrLn fh ""
        hPutStrLn fh "const char* get_embedded_file_content(size_t index) {"
        hPutStrLn fh "\tif (index >= num_embedded_files) return 0;"
        hPutStrLn fh "\treturn embedded_file_contents[index];"
        hPutStrLn fh "}"

    withFile "embedded-files.h" WriteMode $ \fh -> do
        hPutStrLn fh "#pragma once"
        hPutStrLn fh ""
        hPutStrLn fh "#include <stdio.h>"
        hPutStrLn fh "#include <stdlib.h>"
        hPutStrLn fh ""

        hPutStrLn fh "size_t get_num_embedded_files();"
        hPutStrLn fh "const char* get_embedded_file_name(size_t index);"
        hPutStrLn fh "size_t get_embedded_file_content_size(size_t index);"
        hPutStrLn fh "const char* get_embedded_file_content(size_t index);"

    withFile "EmbeddedFiles.hs" WriteMode $ \fh -> do
        hPutStrLn fh "{-# LANGUAGE ForeignFunctionInterface #-}"
        hPutStrLn fh ""
        hPutStrLn fh "module EmbeddedFiles where"
        hPutStrLn fh ""
        hPutStrLn fh "import Foreign.C"
        hPutStrLn fh "foreign import ccall \"get_num_embedded_files\" numEmbeddedFiles :: CInt"
        hPutStrLn fh "foreign import ccall \"get_embedded_file_name\" embeddedFileName :: CInt -> CString"
        hPutStrLn fh "foreign import ccall \"get_embedded_file_content_size\" embeddedFileSize :: CInt -> CInt"
        hPutStrLn fh "foreign import ccall \"get_embedded_file_content\" embeddedFileContentPtr :: CInt -> CString"
        hPutStrLn fh "embeddedFileContent :: CInt -> CStringLen"
        hPutStrLn fh "embeddedFileContent i = (embeddedFileContentPtr i, fromIntegral $ embeddedFileSize i)"

hexByte :: (Integral a, Bits a) => a -> String
hexByte b = ['\\', 'x', hexNibble (highNibble b), hexNibble (lowNibble b)]

highNibble :: (Bits a) => a -> a
highNibble = (.&. 0x0F) . (flip shiftR 4)

lowNibble :: (Bits a) => a -> a
lowNibble = (.&. 0x0F)

hexNibble :: Integral a => a -> Char
hexNibble b =
    digits !! (fromIntegral b)
    where
        digits = ['0'..'9'] ++ ['a'..'f']