commit 3ebe1040dd120a6fea82a2fef8290dfc95bb344b Author: Tissevert Date: Mon Dec 30 12:16:05 2019 +0100 First draft defining the structure of the program, needs to implement «imports» and the actual compilation diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..eea5c71 --- /dev/null +++ b/.gitignore @@ -0,0 +1,24 @@ +# ---> Haskell +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* + diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..edcc120 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for SJW + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..42f34d0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Tissevert + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Tissevert nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..1f9e0c9 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# SJW + +The Simple Javascript Wrench is a tool made to compile a set of independant Javascript modules into a single executable javascript file as expected by a webbrowser. It allows you to write (relatively) clean Javascript and to package it into one single script that will run once the page loading it is loaded. diff --git a/SJW.cabal b/SJW.cabal new file mode 100644 index 0000000..a572918 --- /dev/null +++ b/SJW.cabal @@ -0,0 +1,36 @@ +cabal-version: >=1.10 +-- Initial package description 'SJW.cabal' generated by 'cabal init'. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +name: SJW +version: 0.1.0.0 +synopsis: The Simple Javascript Wrench is a very simple tool to pack several JS «modules» into a single script. +-- description: +homepage: https://git.marvid.fr/Tissevert/SJW +-- bug-reports: +license: BSD3 +license-file: LICENSE +author: Tissevert +maintainer: tissevert+devel@marvid.fr +-- copyright: +category: Web +build-type: Simple +extra-source-files: CHANGELOG.md + +executable sjw + main-is: Main.hs + other-modules: Compiler + , Context + , Module + , Paths_SJW + -- other-extensions: + build-depends: attoparsec + , base >=4.12 && <4.13 + , containers + , directory + , filepath + , mtl + , optparse-applicative + , text + hs-source-dirs: src + default-language: Haskell2010 diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Compiler.hs b/src/Compiler.hs new file mode 100644 index 0000000..a2384db --- /dev/null +++ b/src/Compiler.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +module Compiler ( + main + ) where + +import Context (Contextual) +import Data.Text (Text, cons) +import qualified Data.Text as Text (concat) +import Module (Module(..)) + +indent :: [Text] -> [Text] +indent = fmap (cons '\t') + +include :: Bool -> Module -> Text +include isMain (Module {imports, payload}) = Text.concat $ + header isMain + : indent payload + ++ footer isMain + where + header True = "(function() {\n" + header False = "modules[''] = (function() {\n" + footer True = ["})());"] + footer False = [ + "})());" + , "Object.freeze(modules['']);" + ] + +scan :: Contextual () +scan = undefined + +main :: Contextual Text +main = undefined diff --git a/src/Context.hs b/src/Context.hs new file mode 100644 index 0000000..a8cd742 --- /dev/null +++ b/src/Context.hs @@ -0,0 +1,34 @@ +module Context ( + CodePath(..) + , Context(..) + , Contextual + , Path(..) + ) where + +import Control.Monad.RWS (RWST) +import Data.List (intercalate) +import Data.Map (Map) +import Text.ParserCombinators.ReadP (char, munch, sepBy) +import Text.ParserCombinators.ReadPrec (lift) +import Text.Read (readPrec) + +newtype Path = Path [String] +newtype CodePath = CodePath [FilePath] +type Dependencies = Map Path [Path] + +data Context = Context { + codePaths :: CodePath + , mainModule :: Path + } + +type Contextual = RWST Context [String] Dependencies IO + +instance Show Path where + show (Path components) = intercalate "." components + +instance Read Path where + readPrec = fmap Path . lift $ + munch (/= '.') `sepBy` char '.' + +instance Show CodePath where + show (CodePath dirs) = intercalate ":" dirs diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..0e4c9a1 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE NamedFieldPuns #-} +module Main where + +import qualified Compiler (main) +import Context (CodePath(..), Context (..), Path(..)) +import Control.Applicative (many, optional) +import Control.Monad.RWS (evalRWST) +import qualified Data.Map as Map (empty) +import Data.Text (Text) +import qualified Data.Text as Text (unpack) +import Data.Version (showVersion) +import qualified Module (parse) +import Options.Applicative ( + Parser, execParser, fullDesc, info, header, help, helper, long, metavar + , option, short, str, strArgument, strOption, value + ) +import qualified Paths_SJW as SJW (version) +import System.IO (stderr, hPutStrLn) + +data Config = Config { + includes :: [FilePath] + , mainIs :: String + , outputFile :: FilePath + , target :: FilePath + } deriving (Show) + +configParser :: Parser Config +configParser = Config + <$> many (strOption ( + long "include" + <> short 'I' + <> metavar "PACKAGE" + <> help "Include this package during compilation" + )) + <*> strOption ( + long "main-is" + <> short 'm' + <> metavar "MODULE_NAME" + <> help "The name of the main module containing the code to run" + <> value "Main" + ) + <*> strOption ( + long "output" + <> short 'o' + <> metavar "OUTPUT_PATH" + <> help "The path where to create the compiled script (stdout if \"-\" or if the option is missing)" + <> value "-" + ) + <*> strArgument ( + metavar "SOURCE_DIR" + <> help "The path where to look for the sources" + ) + +getConfig :: IO Config +getConfig = execParser $ + info + (helper <*> configParser) + (fullDesc <> header ("SJW v" ++ showVersion SJW.version)) + +runCompiler :: Config -> IO (Text, [String]) +runCompiler (Config {includes, mainIs, target}) = + flip (evalRWST Compiler.main) Map.empty $ Context { + codePaths = CodePath (target : includes) + , mainModule = read mainIs + } + +main :: IO () +main = do + config@(Config {outputFile}) <- getConfig + (sourceCode, logs) <- runCompiler config + mapM_ (hPutStrLn stderr) logs + output outputFile . Text.unpack $ sourceCode + where + output "-" = putStr + output fileName = writeFile fileName diff --git a/src/Module.hs b/src/Module.hs new file mode 100644 index 0000000..056a95d --- /dev/null +++ b/src/Module.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +module Module ( + Module(..) + , parse + ) where + +import Context (CodePath(..), Context(..), Contextual, Path(..)) +import Control.Applicative ((<|>)) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Reader (asks) +import Data.Attoparsec.Text ( + Parser, char, parseOnly, sepBy, string, takeTill, takeWhile + ) +import Data.Text (Text) +import qualified Data.Text as Text (concat, pack) +import Prelude hiding (takeWhile) +import System.Directory (doesFileExist) +import System.FilePath ((), (<.>)) +import Text.Printf (printf) + +type ImportTree = Int +data Mapping = Mapping { + exposedName :: String + , sourceObject :: String + } + +data Module = Module { + imports :: ImportTree + , payload :: [Text] + } deriving Show + +importParser :: Parser [Mapping] +importParser = + string "import" *> space *> pure [] <* space <* char ';' + where + space = takeWhile (`elem` [' ', '\t']) + +treeOf :: [[Mapping]] -> ImportTree +treeOf = foldl (\n l -> n + length l) 0 + +moduleParser :: Parser Module +moduleParser = Module + <$> (treeOf <$> importParser `sepBy` blank) + <*> line `sepBy` eol + where + eol = string "\r\n" <|> string "\r" <|> string "\n" + blank = takeWhile (`elem` [' ', '\t', '\r', '\n']) + line = takeTill (`elem` ['\r', '\n']) + +parse :: Path -> Contextual (Either String Module) +parse path = do + searchPath <- asks codePaths + maybeSource <- find searchPath path + case maybeSource of + Nothing -> return . Left $ + printf "Module %s not found in paths : %s" (show path) (show searchPath) + Just source -> + parseOnly moduleParser . Text.pack <$> liftIO (readFile source) + +find :: MonadIO m => CodePath -> Path -> m (Maybe FilePath) +find (CodePath []) _ = return Nothing +find (CodePath (dir:otherDirs)) path@(Path components) = do + fileExists <- liftIO $ doesFileExist filePath + if fileExists + then return (Just filePath) + else find (CodePath otherDirs) path + where + filePath = foldl () dir components <.> "js"