{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
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 :: 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 (forall v. [(Key, v)] -> KeyMap v
Map.fromList [(Key, Value)]
obj) where
obj :: [(Key, Value)]
obj = [(Key
"version",forall a. ToJSON a => a -> Value
toJSON Integer
version)
,(Key
"file",forall a. ToJSON a => a -> Value
toJSON FilePath
smFile)
,(Key
"sources",forall a. ToJSON a => a -> Value
toJSON [FilePath]
sources)
,(Key
"names",forall a. ToJSON a => a -> Value
toJSON [Text]
names)
,(Key
"mappings",forall a. ToJSON a => a -> Value
toJSON (ByteString -> Text
decodeUtf8 ([FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings [FilePath]
sources [Text]
names [Mapping]
smMappings)))] forall a. [a] -> [a] -> [a]
++
[(Key
"sourceRoot",forall a. ToJSON a => a -> Value
toJSON FilePath
root) | Just FilePath
root <- [Maybe FilePath
smSourceRoot]]
names :: [Text]
names = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Mapping -> Maybe Text
mapName [Mapping]
smMappings
sources :: [FilePath]
sources = forall {a}. Ord a => (Mapping -> Maybe a) -> [a]
symbols Mapping -> Maybe FilePath
mapSourceFile
symbols :: (Mapping -> Maybe a) -> [a]
symbols Mapping -> Maybe a
f = forall a. Ord a => [a] -> [a]
sort (forall a. Eq a => [a] -> [a]
nub (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Mapping -> Maybe a
f [Mapping]
smMappings))
encodeMappings :: [FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings :: [FilePath] -> [Text] -> [Mapping] -> ByteString
encodeMappings [FilePath]
sources [Text]
names = [Mapping] -> ByteString
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Mapping -> Pos
mapGenerated where
go :: [Mapping] -> ByteString
go [Mapping]
mappings = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
STRef s Int32
prevGenCol <- forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
STRef s Int32
prevGenLine <- forall a s. a -> ST s (STRef s a)
newSTRef Int32
1
STRef s Int32
prevOrigCol <- forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
STRef s Int32
prevOrigLine <- forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
STRef s Int32
prevName <- forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
STRef s Int32
prevSource <- forall a s. a -> ST s (STRef s a)
newSTRef Int32
0
STRef s Builder
result <- forall a s. a -> ST s (STRef s a)
newSTRef (forall a. Monoid a => a
mempty :: Builder)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0::Integer ..] [Mapping]
mappings) 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
forall {s} {b}. STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s Int32
prevGenLine forall a b. (a -> b) -> a -> b
$ \Int32
previousGeneratedLine ->
if Pos -> Int32
posLine Pos
mapGenerated forall a. Eq a => a -> a -> Bool
/= Int32
previousGeneratedLine
then do STRef s Int32
prevGenCol forall {s} {a}. STRef s a -> a -> ST s ()
.= Int32
0
STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= Int64 -> Word8 -> ByteString
B.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int32
posLine Pos
mapGenerated forall a. Num a => a -> a -> a
- Int32
previousGeneratedLine))
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Char
';'))
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posLine Pos
mapGenerated)
else do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
> Integer
0)
(STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= FilePath -> ByteString
U.fromString FilePath
",")
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
previousGeneratedLine
forall {s} {b}. STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s Int32
prevGenCol forall a b. (a -> b) -> a -> b
$ \Int32
previousGeneratedColumn -> do
STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Pos -> Int32
posColumn Pos
mapGenerated forall a. Num a => a -> a -> a
- Int32
previousGeneratedColumn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posColumn Pos
mapGenerated)
case 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (FilePath
source,Pos
original) -> do
forall {s} {b}. STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s Int32
prevSource forall a b. (a -> b) -> a -> b
$ \Int32
previousSource -> do
STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (forall {b} {a}. (Num b, Eq a) => a -> [a] -> b
indexOf FilePath
source [FilePath]
sources forall a. Num a => a -> a -> a
- Int32
previousSource)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {b} {a}. (Num b, Eq a) => a -> [a] -> b
indexOf FilePath
source [FilePath]
sources)
forall {s} {b}. STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s Int32
prevOrigLine forall a b. (a -> b) -> a -> b
$ \Int32
previousOriginalLine -> do
STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Pos -> Int32
posLine Pos
original forall a. Num a => a -> a -> a
- Int32
1 forall a. Num a => a -> a -> a
- Int32
previousOriginalLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posLine Pos
original forall a. Num a => a -> a -> a
- Int32
1)
forall {s} {b}. STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s Int32
prevOrigCol forall a b. (a -> b) -> a -> b
$ \Int32
previousOriginalColumn -> do
STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (Pos -> Int32
posColumn Pos
original forall a. Num a => a -> a -> a
- Int32
previousOriginalColumn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pos -> Int32
posColumn Pos
original)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
mapName forall a b. (a -> b) -> a -> b
$ \Text
name -> do
forall {s} {b}. STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s Int32
prevName forall a b. (a -> b) -> a -> b
$ \Int32
previousName -> do
STRef s Builder
result forall {s}. STRef s Builder -> ByteString -> ST s ()
+= Int32 -> ByteString
VLQ.encode (forall {b} {a}. (Num b, Eq a) => a -> [a] -> b
indexOf Text
name [Text]
names forall a. Num a => a -> a -> a
- Int32
previousName)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {b} {a}. (Num b, Eq a) => a -> [a] -> b
indexOf Text
name [Text]
names)
Builder -> ByteString
toLazyByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. STRef s a -> ST s a
readSTRef STRef s Builder
result
updating :: STRef s b -> (b -> ST s b) -> ST s ()
updating STRef s b
r b -> ST s b
f = forall s a. STRef s a -> ST s a
readSTRef STRef s b
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> ST s b
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall {s} {a}. STRef s a -> a -> ST s ()
writeSTRef STRef s b
r)
STRef s Builder
r += :: STRef s Builder -> ByteString -> ST s ()
+= ByteString
y = forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Builder
r (forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
y)
STRef s a
x .= :: STRef s a -> a -> ST s ()
.= a
y = 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
e [a]
xs))
version :: Integer
version :: Integer
version = Integer
3