{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Compiler (
    main
  ) where

import Context (Context(..), Contextual, Path)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.RWS (asks, gets)
import Data.Map ((!))
import qualified Data.Map as Map (member)
import Data.Text (Text, cons)
import qualified Data.Text as Text (null, unlines)
import Module (Environment, Failable, Log, Module(..), Log)
import qualified Module (parse)
import qualified Module.Environment as Environment (
    Environment(..), register, reorder
  )
import Module.File (File(..), variables)
import qualified Module.File as File (header, footer)
import qualified Priority (set, toList)

type Compiler m = (Contextual m, Log m, Environment m, MonadIO m, Failable m)

indent :: [Text] -> [Text]
indent = fmap indentLine
  where
    indentLine t
      | Text.null t = t
      | otherwise = cons '\t' t

include :: Environment m => (Int, Path) -> m [Text]
include (priority, path) = do
  File {imports, payload} <- gets (file . (! path) . Environment.modules)
  let (names, values) = unzip $ variables imports
  return $ File.header isMain path names : indent payload ++ File.footer values
  where
    isMain = priority == 0

scan :: Compiler m => Int -> Path -> m ()
scan priority modulePath = do
  Environment.reorder $ Priority.set modulePath priority
  alreadyLoaded <- gets (Map.member modulePath . Environment.modules)
  if alreadyLoaded then return () else load
  where
    load :: Compiler m => m ()
    load = do
      newModule <- Module.parse modulePath
      Environment.register modulePath newModule
      mapM_ (scan (priority + 1)) $ dependencies newModule

body :: Compiler m => m [Text]
body = do
  sortedPath <- gets (Priority.toList . Environment.queue)
  includes <- concat <$> mapM include sortedPath
  return $ "var modules = {};" : includes

main :: Compiler m => m Text
main = do
  scan 0 =<< asks mainModule
  codeBody <- body
  return . Text.unlines $ openOnLoad : indent codeBody ++ [closeOnLoad]
  where
    openOnLoad = "window.addEventListener('load', function() {"
    closeOnLoad = "});"