65 lines
2.1 KiB
Haskell
65 lines
2.1 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module SJW.Compiler (
|
|
main
|
|
) where
|
|
|
|
import SJW.Source (Source(..), HasSource, Path)
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Control.Monad.RWS (ask, 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 SJW.Dependencies as Dependencies (Failable, solve)
|
|
import SJW.Module (Environment, Log, Module(..), Modules(..))
|
|
import qualified SJW.Module as Module (parse, register)
|
|
import SJW.Module.File (File(..), variables)
|
|
import qualified SJW.Module.File as File (header, footer)
|
|
|
|
type Compiler m = (HasSource 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 => Path -> m [Text]
|
|
include path = do
|
|
File {isMain, imports, payload} <- gets (file . (! path) . modules)
|
|
let (names, values) = unzip $ variables imports
|
|
return $ File.header isMain path names : indent payload ++ File.footer values
|
|
|
|
scan :: Compiler m => Bool -> Path -> m ()
|
|
scan isMain modulePath = do
|
|
alreadyLoaded <- gets (Map.member modulePath . modules)
|
|
if alreadyLoaded then return () else load
|
|
where
|
|
load :: Compiler m => m ()
|
|
load = do
|
|
newModule <- Module.parse isMain modulePath
|
|
Module.register modulePath newModule
|
|
mapM_ (scan False) $ dependencies newModule
|
|
|
|
body :: Compiler m => m [Text]
|
|
body = do
|
|
sortedPath <- Dependencies.solve =<< dependenciesGraph
|
|
includes <- concat <$> mapM include sortedPath
|
|
return $ "var modules = {};" : includes
|
|
where
|
|
dependenciesGraph = gets (fmap dependencies . modules)
|
|
|
|
main :: Compiler m => m Text
|
|
main = do
|
|
Source {mainModule} <- ask
|
|
scan True mainModule
|
|
codeBody <- body
|
|
return . Text.unlines $ openOnLoad : indent codeBody ++ [closeOnLoad]
|
|
where
|
|
openOnLoad = "window.addEventListener('load', function() {"
|
|
closeOnLoad = "});"
|