{-# LANGUAGE CPP         #-}
{-# LANGUAGE QuasiQuotes #-}

module Ivory.Compile.C.Modules where

import           Paths_ivory_backend_c     (version)

import           Prelude                   ()
import           Prelude.Compat

import           Text.PrettyPrint.Mainland
#if MIN_VERSION_mainland_pretty(0,6,0)
import           Text.PrettyPrint.Mainland.Class
#endif

import qualified Ivory.Language.Syntax.AST as I

import           Ivory.Compile.C.Gen
import           Ivory.Compile.C.Types

import           Control.Monad             (unless, when)
import           Data.Char                 (toUpper)
import           Data.Maybe                (fromJust, isJust)
import           Data.Version              (showVersion)
import           MonadLib                  (put, runM)
import           System.FilePath.Posix     ((<.>))

--------------------------------------------------------------------------------

showModule :: CompileUnits -> String
showModule m = unlines $ map unlines $
  [ mk (lbl "Source") (sources m)
  , mk (lbl "Header") (headers m)
  ]
  where
  lbl l = "// module " ++ unitName m ++ " " ++ l ++ ":\n"
  mk _   (_,[])         = []
  mk str (incls,units)  = str : pp (mkDefs (incls, units))
  pp = map (pretty maxWidth . ppr)

--------------------------------------------------------------------------------

compilerVersion :: String
compilerVersion = showVersion version

---
topComments :: Doc
topComments  = text "/* This file has been autogenerated by Ivory" </>
               text " * Compiler version " <+> text compilerVersion </>
               text " */"

renderHdr :: (Includes, Sources) -> String -> String
renderHdr s unitname = displayS (render maxWidth guardedHeader) ""
  where
  guardedHeader = stack [ topComments
                        , topGuard
                        , topExternC
                        , ppr (mkDefs s)
                        , botExternC
                        , botGuard
                        ]
  topGuard        = text "#ifndef" <+> guardName </> text "#define"
                      <+> guardName
  botGuard        = text "#endif" <+> text "/*" <+> guardName <+> text "*/\n"
  unitname'       = map (\c -> if c == '-' then '_' else c) unitname
  guardName       = text "__" <> text (toUpper <$> unitname') <> text "_H__"
  topExternC      = stack $ text <$> [ "#ifdef __cplusplus"
                                     , "extern \"C\" {"
                                     , "#endif"]
  botExternC      = stack $ text <$> [ "#ifdef __cplusplus"
                                     , "}"
                                     , "#endif"]

renderSrc :: (Includes, Sources) -> String
renderSrc s = displayS (render maxWidth srcdoc) ""
  where
  srcdoc = topComments </> out </> text ""
  out = stack $ punctuate line $ map ppr $ mkDefs s

--------------------------------------------------------------------------------

runOpt :: (I.Proc -> I.Proc) -> I.Module -> I.Module
runOpt opt m =
  m { I.modProcs = procs' }
  where
  procs' = procs { I.public = map' I.public, I.private = map' I.private }
  procs = I.modProcs m
  map' acc = map opt (acc procs)

--------------------------------------------------------------------------------

-- | Compile a module.
compileModule :: Maybe String -> I.Module -> CompileUnits
compileModule hdr I.Module { I.modName        = nm
                           , I.modDepends     = deps
                           , I.modHeaders     = hdrs
                           , I.modImports     = imports
                           , I.modExterns     = externs
                           , I.modProcs       = procs
                           , I.modStructs     = structs
                           , I.modAreas       = areas
                           , I.modAreaImports = ais
                           }
  = CompileUnits
  { unitName = nm
  , sources  = sources res
  , headers  = headers res
  }
  where
  res     = compRes comp
  compRes = (snd . runM . unCompile)

  unitHdr = LocalInclude (nm <.> "h")

  comp = do
    let c = compRes comp0
    unless (null (snd (headers c))) (putSrcInc unitHdr)
    Compile (put c)

  comp0 :: Compile
  comp0 = do
    putHdrInc (LocalInclude "ivory.h")
    when (isJust hdr)
      (putHdrInc (LocalInclude (fromJust hdr)))
    -- module names don't have a .h on the end
    mapM_ (putHdrInc . LocalInclude . ((<.> "h"))) deps
    mapM_ (putHdrInc . LocalInclude) hdrs
    mapM_ (compileStruct Public) (I.public structs)
    mapM_ (compileStruct Private) (I.private structs)
    mapM_ fromImport imports
    mapM_ fromExtern externs
    mapM_ (extractAreaProto Public) (I.public areas)
    mapM_ (extractAreaProto Private) (I.private areas)
    mapM_ (compileArea Public) (I.public areas)
    mapM_ (compileArea Private) (I.private areas)
    mapM_ compileAreaImport ais
    mapM_ (extractProto Public) (I.public procs)
    mapM_ (extractProto Private) (I.private procs)
    mapM_ compileUnit (I.public procs ++ I.private procs)

--------------------------------------------------------------------------------

fromImport :: I.Import -> Compile
fromImport p = putHdrInc (SysInclude (I.importFile p))

--------------------------------------------------------------------------------

fromExtern :: I.Extern -> Compile
fromExtern p = putHdrInc (SysInclude (I.externFile p))

--------------------------------------------------------------------------------

outputProcSyms :: [I.Module] -> IO ()
outputProcSyms mods = putStrLn $ unwords $ concatMap go mods
  where
  go :: I.Module -> [String]
  go m = map I.procSym (pub ++ priv)
    where I.Visible pub priv = I.modProcs m

--------------------------------------------------------------------------------

-- This is generated code, and sometimes, we have large expressions. In
-- practice, this means that once the width is reached, one token is placed per
-- line(!). So we'll make a high limit for width, somewhat ironically making
-- generated C more readable.
maxWidth :: Int
maxWidth = 400

mkDefs :: ([Include], Sources) -> Sources
mkDefs (incls, defs) = map includeDef incls ++ defs