diff --git a/bench/Bench/VLQ.hs b/bench/Bench/VLQ.hs new file mode 100644 --- /dev/null +++ b/bench/Bench/VLQ.hs @@ -0,0 +1,20 @@ +-- | Benchmark the VLQ implementation. + +module Main where + +import Criterion.Main +import GHC.Int +import System.Random +import VLQ + +-- | Runs a few randomly generated numbers (from the same seed each +-- time). +main :: IO () +main = do + defaultMain [benchmark] + where benchmark = bgroup "numbers" + (map (\n -> bench (show n) (whnf encode n)) + (map (fromIntegral :: Int -> Int32) + (take 5 + (randomRs (1000000000,2000000000) + (mkStdGen 1))))) diff --git a/sourcemap.cabal b/sourcemap.cabal --- a/sourcemap.cabal +++ b/sourcemap.cabal @@ -1,5 +1,5 @@ name: sourcemap -version: 0.1.3.0 +version: 0.1.5 synopsis: Implementation of source maps as proposed by Google and Mozilla. description: Implementation of source maps, revision 3, proposed by Google and Mozilla here and here @@ -15,7 +15,7 @@ cabal-version: >=1.8 library - ghc-options: -O2 + ghc-options: -O2 -Wall exposed-modules: SourceMap, SourceMap.Types other-modules: VLQ hs-source-dirs: src @@ -27,3 +27,27 @@ process, utf8-string, text + + +test-suite nodejs + type: exitcode-stdio-1.0 + main-is: Node.hs + hs-source-dirs: src test + build-depends: base, + sourcemap, + process, + utf8-string, + bytestring, + aeson, + text, + unordered-containers + +benchmark vlq + type: exitcode-stdio-1.0 + hs-source-dirs: src bench + main-is: Bench/VLQ.hs + build-depends: base, + criterion, + bytestring, + random + ghc-options: -O2 -Wall diff --git a/src/SourceMap.hs b/src/SourceMap.hs --- a/src/SourceMap.hs +++ b/src/SourceMap.hs @@ -15,8 +15,10 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as Bytes import Data.ByteString.Lazy.UTF8 (fromString) +import Data.ByteString.Builder (Builder(), lazyByteString, toLazyByteString) import Data.Foldable (forM_) import qualified Data.HashMap.Lazy as Map +import Data.Monoid import Data.List import Data.Maybe import Data.Ord @@ -48,7 +50,7 @@ prevOrigLine <- newSTRef 0 prevName <- newSTRef 0 prevSource <- newSTRef 0 - result <- newSTRef Bytes.empty + result <- newSTRef (mempty :: Builder) -- Generate the groupings. forM_ (zip [0::Integer ..] mappings) $ \(i,Mapping{..}) -> do -- Continuations on the same line are separated by “,”, whereas @@ -88,10 +90,10 @@ result += VLQ.encode (indexOf name names - previousName) return (indexOf name names) -- Return the byte buffer. - readSTRef result + toLazyByteString <$> readSTRef result updating r f = readSTRef r >>= \x -> f x >>= writeSTRef r - r += y = modifySTRef r (\x -> Bytes.append x y) + r += y = modifySTRef r (<> lazyByteString y) x .= y = writeSTRef x y; infixr 1 .= indexOf e xs = fromIntegral (fromMaybe 0 (elemIndex e xs)) diff --git a/src/SourceMap/Types.hs b/src/SourceMap/Types.hs --- a/src/SourceMap/Types.hs +++ b/src/SourceMap/Types.hs @@ -11,24 +11,26 @@ -- | The source mapping. data SourceMapping = SourceMapping - { smFile :: FilePath - , smSourceRoot :: Maybe FilePath - , smMappings :: [Mapping] + { smFile :: !FilePath + , smSourceRoot :: !(Maybe FilePath) + , smMappings :: ![Mapping] } deriving Show -- | A mapping. data Mapping = Mapping - { mapGenerated :: Pos - , mapOriginal :: Maybe Pos - , mapSourceFile :: Maybe FilePath - , mapName :: Maybe Text + { mapGenerated :: !Pos + , mapOriginal :: !(Maybe Pos) + , mapSourceFile :: !(Maybe FilePath) + , mapName :: !(Maybe Text) } deriving Show -- | A source position. data Pos = Pos - { posLine :: Int32 - , posColumn :: Int32 + { posLine :: !Int32 + , posColumn :: !Int32 } deriving (Eq,Show) +-- | Compares the line, then the column. instance Ord Pos where - compare a b = on compare posLine a b <> on compare posColumn a b + compare a b = + on compare posLine a b <> on compare posColumn a b diff --git a/test/Node.hs b/test/Node.hs new file mode 100644 --- /dev/null +++ b/test/Node.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | This test suite requires the source-map node package. That is the +-- reference implementation, so we generate sourcemaps and compare +-- them with what the source-map package would generate. + +module Main where + +import SourceMap +import SourceMap.Types + +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as Bytes +import qualified Data.ByteString.Lazy.UTF8 as Bytes +import Data.List +import System.Exit +import System.Process.Extra + +-- | Run the test suite. +main :: IO () +main = + compareImplementations + SourceMapping { smFile = "out.js" + , smSourceRoot = Nothing + , smMappings = mappings } + +-- | Compare the Haskell implementation with the JavaScript +-- implementation for the given source mapping. +compareImplementations :: SourceMapping -> IO () +compareImplementations m = do + !n <- generateNode m + let !h = generate m + if h == n + then exitSuccess + else do putStr $ "Node: "; Bytes.putStrLn $ encode n + putStr "Haskell: "; Bytes.putStrLn $ encode h + exitFailure + +-- | Generate a source map using the nodejs source-map package. +generateNode :: SourceMapping -> IO Value +generateNode SourceMapping{..} = do + result <- readAllFromProcess' "node" [] source + case result of + Left err -> error err + Right (_err,out) -> + case decode (Bytes.fromString (concat (lines out))) of + Just value -> return value + Nothing -> error "unable to parse node's json output" + + where source = unlines $ + ["var s = require('source-map');" + ,"" + ,"var generator = new s.SourceMapGenerator({"] ++ + [intercalate "," (["file: " ++ show smFile] ++ + ["sourceRoot: " ++ show root | Just root <- [smSourceRoot]])] ++ + ["});" + ,""] ++ + map addMapping smMappings ++ + ["console.log(generator.toString())"] + addMapping Mapping{..} = unlines $ + ["generator.addMapping({" + ," generated: " ++ showPos mapGenerated ++ ","] ++ + [" original: " ++ showPos orig ++ "," | Just orig <- [mapOriginal]] ++ + [" source: " ++ show src ++ "," | Just src <- [mapSourceFile]] ++ + [" name: " ++ show name | Just name <- [mapName]] ++ + ["});"] + showPos Pos{..} = "{ line: " ++ show posLine ++ ", column: " ++ show posColumn ++ " }" + +-- | A sample source mapping. +mappings :: [Mapping] +mappings = + [Mapping { + mapGenerated = Pos 1 1, + mapOriginal = Just (Pos 1 1), + mapSourceFile = Just "one.js", + mapName = Nothing + } + ,Mapping { + mapGenerated = Pos 1 5, + mapOriginal = Just (Pos 1 5), + mapSourceFile = Just "one.js", + mapName = Nothing + } + ,Mapping { + mapGenerated = Pos 1 9, + mapOriginal = Just (Pos 1 11), + mapSourceFile = Just "one.js", + mapName = Nothing + } + ,Mapping { + mapGenerated = Pos 1 18, + mapOriginal = Just (Pos 1 21), + mapSourceFile = Just "one.js", + mapName = Just "bar" + } + ,Mapping { + mapGenerated = Pos 1 21, + mapOriginal = Just (Pos 2 3), + mapSourceFile = Just "one.js", + mapName = Nothing + } + ,Mapping { + mapGenerated = Pos 1 28, + mapOriginal = Just (Pos 2 10), + mapSourceFile = Just "one.js", + mapName = Just "baz" + } + ,Mapping { + mapGenerated = Pos 1 32, + mapOriginal = Just (Pos 2 14), + mapSourceFile = Just "one.js", + mapName = Just "bar" + } + ,Mapping { + mapGenerated = Pos 2 1, + mapOriginal = Just (Pos 1 1), + mapSourceFile = Just "two.js", + mapName = Nothing + } + ,Mapping { + mapGenerated = Pos 2 5, + mapOriginal = Just (Pos 1 5), + mapSourceFile = Just "two.js", + mapName = Nothing + } + ,Mapping { + mapGenerated = Pos 2 9, + mapOriginal = Just (Pos 1 11), + mapSourceFile = Just "two.js", + mapName = Nothing + }, + Mapping { + mapGenerated = Pos 2 18, + mapOriginal = Just (Pos 1 21), + mapSourceFile = Just "two.js", + mapName = Just "n" + }, + Mapping { + mapGenerated = Pos 2 21, + mapOriginal = Just (Pos 2 3), + mapSourceFile = Just "two.js", + mapName = Nothing + }, + Mapping { + mapGenerated = Pos 2 28, + mapOriginal = Just (Pos 2 10), + mapSourceFile = Just "two.js", + mapName = Just "n" + }]