68 lines
2.1 KiB
Haskell
68 lines
2.1 KiB
Haskell
{-# 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 = "});"
|