SJW/src/SJW/Compiler.hs

83 lines
2.8 KiB
Haskell

--- SJW -- Clean Javascript modules for front-end development
--- Copyright © 2022 Tissevert <tissevert+devel@marvid.fr>
---
--- This file is part of SJW.
---
--- SJW is free software: you can redistribute it and/or modify it under the
--- terms of the GNU General Public License as published by the Free Software
--- Foundation, either version 3 of the License, or (at your option) any later
--- version.
---
--- SJW is distributed in the hope that it will be useful, but WITHOUT ANY
--- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
--- details.
---
--- You should have received a copy of the GNU General Public License along
--- with this program. If not, see <http://www.gnu.org/licenses/>.
{-# 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 = "});"