First draft defining the structure of the program, needs to implement «imports» and the actual compilation

.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.*
+

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for SJW
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

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.

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.

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

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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

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

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

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"