{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Generate JSON from a source mapping.

module SourceMap (generate) where

import           SourceMap.Types
import qualified VLQ

import           Control.Monad hiding (forM_)
import           Control.Monad.ST
import           Data.Aeson hiding ((.=))
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
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import           Data.List
import           Data.Maybe
import           Data.Ord
import           Data.STRef
import           Data.Text (Text)
import           Data.Text.Lazy.Encoding (decodeUtf8)

-- | Generate the JSON from a source mapping.
generate :: SourceMapping -> Value
generate :: SourceMapping -> Value
generate SourceMapping{..} = Object -> Value
Object ([(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Text, Value)]
obj) where
  obj :: [(Text, Value)]
obj = [("version",Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
version)
        ,("file",FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON FilePath
smFile)
        ,("sources",[FilePath] -> Value
forall a. ToJSON a => a -> Value
toJSON [FilePath]
sources)
        ,("names",[Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
names)
        ,("mappings",Text -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString -> Text
decodeUtf8 ([FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings [FilePath]
sources [Text]
names [Mapping]
smMappings)))] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++
        [("sourceRoot",FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON FilePath
root) | Just root :: FilePath
root <- [Maybe FilePath
smSourceRoot]]
  names :: [Text]
names = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Mapping -> Maybe Text) -> [Mapping] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Mapping -> Maybe Text
mapName [Mapping]
smMappings
  sources :: [FilePath]
sources = (Mapping -> Maybe FilePath) -> [FilePath]
forall a. Ord a => (Mapping -> Maybe a) -> [a]
symbols Mapping -> Maybe FilePath
mapSourceFile
  symbols :: (Mapping -> Maybe a) -> [a]
symbols f :: Mapping -> Maybe a
f = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub ((Mapping -> Maybe a) -> [Mapping] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Mapping -> Maybe a
f [Mapping]
smMappings))

-- | Encode the mappings to the source map format.
encodeMappings :: [FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings :: [FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings sources :: [FilePath]
sources names :: [Text]
names = [Mapping] -> ByteString
go ([Mapping] -> ByteString)
-> ([Mapping] -> [Mapping]) -> [Mapping] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mapping -> Mapping -> Ordering) -> [Mapping] -> [Mapping]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Mapping -> Pos) -> Mapping -> Mapping -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Mapping -> Pos
mapGenerated) where
  go :: [Mapping] -> ByteString
go mappings :: [Mapping]
mappings = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    -- State.
    STRef s Int32
prevGenCol   <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef 0
    STRef s Int32
prevGenLine  <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef 1
    STRef s Int32
prevOrigCol  <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef 0
    STRef s Int32
prevOrigLine <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef 0
    STRef s Int32
prevName     <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef 0
    STRef s Int32
prevSource   <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef 0
    STRef s Builder
result       <- Builder -> ST s (STRef s Builder)
forall a s. a -> ST s (STRef s a)
newSTRef (Builder
forall a. Monoid a => a
mempty :: Builder)
    -- Generate the groupings.
    [(Integer, Mapping)] -> ((Integer, Mapping) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Integer] -> [Mapping] -> [(Integer, Mapping)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0::Integer ..] [Mapping]
mappings) (((Integer, Mapping) -> ST s ()) -> ST s ())
-> ((Integer, Mapping) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(i :: Integer
i,Mapping{..}) -> do
      -- Continuations on the same line are separated by “,”, whereas
      -- new lines are separted by “;”.
      STRef s Int32 -> (Int32 -> ST s Int32) -> ST s ()
forall s a. STRef s a -> (a -> ST s a) -> ST s ()
updating STRef s Int32
prevGenLine ((Int32 -> ST s Int32) -> ST s ())
-> (Int32 -> ST s Int32) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \previousGeneratedLine :: Int32
previousGeneratedLine ->
        if Pos -> Int32
posLine Pos
mapGenerated Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
previousGeneratedLine
           then do STRef s Int32
prevGenCol STRef s Int32 -> Int32 -> ST s ()
forall s a. STRef s a -> a -> ST s ()
.= 0
                   STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int64 -> Word8 -> ByteString
Bytes.replicate (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int32
posLine Pos
mapGenerated Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
previousGeneratedLine))
                                             (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum ';'))
                   Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posLine Pos
mapGenerated)
           else do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
                        (STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= FilePath -> ByteString
fromString ",")
                   Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
previousGeneratedLine
      -- Original generated column (also offsetted from previous entries).
      STRef s Int32 -> (Int32 -> ST s Int32) -> ST s ()
forall s a. STRef s a -> (a -> ST s a) -> ST s ()
updating STRef s Int32
prevGenCol ((Int32 -> ST s Int32) -> ST s ())
-> (Int32 -> ST s Int32) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \previousGeneratedColumn :: Int32
previousGeneratedColumn -> do
        STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Pos -> Int32
posColumn Pos
mapGenerated Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
previousGeneratedColumn)
        Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posColumn Pos
mapGenerated)
      -- Optional additional fields.
      case (FilePath -> Pos -> (FilePath, Pos))
-> Maybe FilePath -> Maybe Pos -> Maybe (FilePath, Pos)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Maybe FilePath
mapSourceFile Maybe Pos
mapOriginal of
        Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (source :: FilePath
source,original :: Pos
original) -> do
          -- Source index.
          STRef s Int32 -> (Int32 -> ST s Int32) -> ST s ()
forall s a. STRef s a -> (a -> ST s a) -> ST s ()
updating STRef s Int32
prevSource ((Int32 -> ST s Int32) -> ST s ())
-> (Int32 -> ST s Int32) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \previousSource :: Int32
previousSource -> do
           STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (FilePath -> [FilePath] -> Int32
forall b a. (Num b, Eq a) => a -> [a] -> b
indexOf FilePath
source [FilePath]
sources Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
previousSource)
           Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath] -> Int32
forall b a. (Num b, Eq a) => a -> [a] -> b
indexOf FilePath
source [FilePath]
sources)
          -- Original line (also offsetted from previous entries).
          STRef s Int32 -> (Int32 -> ST s Int32) -> ST s ()
forall s a. STRef s a -> (a -> ST s a) -> ST s ()
updating STRef s Int32
prevOrigLine ((Int32 -> ST s Int32) -> ST s ())
-> (Int32 -> ST s Int32) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \previousOriginalLine :: Int32
previousOriginalLine -> do
           STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Pos -> Int32
posLine Pos
original Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- 1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
previousOriginalLine)
           Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posLine Pos
original Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- 1)
          -- Original column (also offsetted from previous entries).
          STRef s Int32 -> (Int32 -> ST s Int32) -> ST s ()
forall s a. STRef s a -> (a -> ST s a) -> ST s ()
updating STRef s Int32
prevOrigCol ((Int32 -> ST s Int32) -> ST s ())
-> (Int32 -> ST s Int32) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \previousOriginalColumn :: Int32
previousOriginalColumn -> do
           STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Pos -> Int32
posColumn Pos
original Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
previousOriginalColumn)
           Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posColumn Pos
original)
          -- Optional name
          Maybe Text -> (Text -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
mapName ((Text -> ST s ()) -> ST s ()) -> (Text -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \name :: Text
name -> do
            STRef s Int32 -> (Int32 -> ST s Int32) -> ST s ()
forall s a. STRef s a -> (a -> ST s a) -> ST s ()
updating STRef s Int32
prevName ((Int32 -> ST s Int32) -> ST s ())
-> (Int32 -> ST s Int32) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \previousName :: Int32
previousName -> do
             STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Text -> [Text] -> Int32
forall b a. (Num b, Eq a) => a -> [a] -> b
indexOf Text
name [Text]
names Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
previousName)
             Int32 -> ST s Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text] -> Int32
forall b a. (Num b, Eq a) => a -> [a] -> b
indexOf Text
name [Text]
names)
    -- Return the byte buffer.
    Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> ST s Builder -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s Builder -> ST s Builder
forall s a. STRef s a -> ST s a
readSTRef STRef s Builder
result

  updating :: STRef s a -> (a -> ST s a) -> ST s ()
updating r :: STRef s a
r f :: a -> ST s a
f = STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef STRef s a
r ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> ST s a
f (a -> ST s a) -> (a -> ST s ()) -> a -> ST s ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s a
r)
  r :: STRef s Builder
r += :: STRef s Builder -> ByteString -> ST s ()
+= y :: ByteString
y = STRef s Builder -> (Builder -> Builder) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Builder
r (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
y)
  x :: STRef s a
x .= :: STRef s a -> a -> ST s ()
.= y :: a
y = STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s a
x a
y; infixr 1 .=
  indexOf :: a -> [a] -> b
indexOf e :: a
e xs :: [a]
xs = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
e [a]
xs))

-- | Format version.
version :: Integer
version :: Integer
version = 3