{-# 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 ((.=))
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as Map
#else
import qualified Data.HashMap.Lazy as Map
#endif
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.UTF8 as U
import           Data.ByteString.Builder (Builder(), lazyByteString, toLazyByteString)
import           Data.Foldable (forM_)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import           Data.List
import           Data.Maybe
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{FilePath
[Mapping]
Maybe FilePath
smMappings :: SourceMapping -> [Mapping]
smSourceRoot :: SourceMapping -> Maybe FilePath
smFile :: SourceMapping -> FilePath
smMappings :: [Mapping]
smSourceRoot :: Maybe FilePath
smFile :: FilePath
..} = Object -> Value
Object ([(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
Map.fromList [(Key, Value)]
obj) where
  obj :: [(Key, Value)]
obj = [(Key
"version",Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
version)
        ,(Key
"file",FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON FilePath
smFile)
        ,(Key
"sources",[FilePath] -> Value
forall a. ToJSON a => a -> Value
toJSON [FilePath]
sources)
        ,(Key
"names",[Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
names)
        ,(Key
"mappings",Text -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString -> Text
decodeUtf8 ([FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings [FilePath]
sources [Text]
names [Mapping]
smMappings)))] [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++
        [(Key
"sourceRoot",FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON FilePath
root) | Just 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 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 [FilePath]
sources [Text]
names = [Mapping] -> ByteString
go ([Mapping] -> ByteString)
-> ([Mapping] -> [Mapping]) -> [Mapping] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mapping -> Pos) -> [Mapping] -> [Mapping]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Mapping -> Pos
mapGenerated where
  go :: [Mapping] -> ByteString
go [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 Int32
0
    STRef s Int32
prevGenLine  <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef Int32
1
    STRef s Int32
prevOrigCol  <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
    STRef s Int32
prevOrigLine <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
    STRef s Int32
prevName     <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
    STRef s Int32
prevSource   <- Int32 -> ST s (STRef s Int32)
forall a s. a -> ST s (STRef s a)
newSTRef Int32
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 [Integer
0::Integer ..] [Mapping]
mappings) (((Integer, Mapping) -> ST s ()) -> ST s ())
-> ((Integer, Mapping) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Integer
i,Mapping{Maybe FilePath
Maybe Text
Maybe Pos
Pos
mapOriginal :: Mapping -> Maybe Pos
mapName :: Maybe Text
mapSourceFile :: Maybe FilePath
mapOriginal :: Maybe Pos
mapGenerated :: Pos
mapGenerated :: Mapping -> Pos
mapSourceFile :: Mapping -> Maybe FilePath
mapName :: Mapping -> Maybe Text
..}) -> 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
$ \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 ()
.= Int32
0
                   STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= Int64 -> Word8 -> ByteString
B.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 Char
';'))
                   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
> Integer
0)
                        (STRef s Builder
result STRef s Builder -> ByteString -> ST s ()
forall s. STRef s Builder -> ByteString -> ST s ()
+= FilePath -> ByteString
U.fromString FilePath
",")
                   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
$ \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
        Maybe (FilePath, Pos)
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (FilePath
source,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
$ \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
$ \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
- Int32
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
- Int32
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
$ \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
$ \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
$ \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 STRef s a
r 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)
  STRef s Builder
r += :: STRef s Builder -> ByteString -> ST s ()
+= 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)
  STRef s a
x .= :: STRef s a -> a -> ST s ()
.= 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 a
e [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 Int
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 = Integer
3