balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[LIGO-41] Convert ligo scopes to ScopedDecl

Browse Source
This commit is contained in:
Anton Myasnikov 2020-09-03 15:18:56 +03:00
parent d5154dff36
commit 619a7de432
No known key found for this signature in database
GPG Key ID: FEB685E6DAA0A95F
2 changed files with 181 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
tools/lsp/squirrel/src/Cli/Impl.hs
View File

@ -1,18 +1,24 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric, DerivingVia, RecordWildCards #-}
-- | Module that handles ligo binary execution.
module Cli.Impl where
module Cli.Impl
( LigoError(..)
, callLigo
, parseLigoScopes
, parseLigoTypesFor
, getLigoScopesRaw
, getLigoScopedDecls
, getLigoTypesFor
, parseScopedDecls
) where
import Cli.Json
import Cli.Types
import Control.Exception (Exception (..), IOException, catch, throwIO)
import Control.Lens hiding ((<.>))
import Control.Monad.Catch (MonadThrow (throwM))
import Data.Aeson
import Data.Aeson.Lens
import qualified Data.ByteString.Lazy.Char8 as C8
import qualified Data.HashMap.Strict as HM
import Data.Text
import Data.Text.Encoding (encodeUtf8)
import Duplo.Pretty
@ -20,6 +26,10 @@ import System.Exit
import System.IO
import System.Process (readProcessWithExitCode)
import AST.Scope
import Cli.Json
import Cli.Types
----------------------------------------------------------------------------
-- Errors
----------------------------------------------------------------------------
@ -118,13 +128,51 @@ readProcessWithExitCode' fp args inp =
-- Execution
----------------------------------------------------------------------------
----------------------------------------------------------------------------
-- Parse from output file
-- | Parse scope from ligo output file generated by
-- ```
-- ligo get-scope contract --format=json --with-types
-- ```
-- and return a hashmap of scope name and our internal scope declarations.
parseScopedDecls
:: FilePath
-> IO (HM.HashMap Text ScopedDecl)
parseScopedDecls contractPath = do
scopes <- parseLigoScopes contractPath
return $ fmap toScopedDecl scopes
-- | Parse scope from ligo output file generated by
-- ```
-- ligo get-scope contract --format=json --with-types
-- ```
-- and return a hashmap of scope name and its values.
parseLigoScopes
:: FilePath
-> IO (HM.HashMap Text LigoScope)
parseLigoScopes contractPath =
let interpret :: Value -> HM.HashMap Text LigoScope
interpret scopes =
scopes
^?! key "definitions" -- TODO: may error here
. key "variables"
^@.. members
. (_JSON :: Prism' Value LigoScope)
^. to HM.fromList
in do
output <- C8.readFile contractPath
case eitherDecodeStrict' @Value . encodeUtf8 . pack . C8.unpack $ output of
Left err -> throwM $ ScopeParseError (pack err)
Right scopes -> return $ interpret scopes
-- | Extract types from a ligo scope resolution file generated by
-- ```
-- ligo get-scope contract --format=json --with-types
-- ```
parseLigoTypesFor
:: FilePath
-> Text
:: FilePath -- ^ Ligo output file path
-> Text -- ^ Declaration name
-> IO [(Text, LigoTypeFull)]
parseLigoTypesFor contractPath name = do
output <- C8.readFile contractPath
@ -136,13 +184,15 @@ parseLigoTypesFor contractPath name = do
Nothing -> throwM $ VariableExtractError scopes
Just variables' -> return $ extractLigoTypesFrom name variables'
-- | Get scopes from ligo compiler and extract a list of types associated with some specific variable.
getLigoTypesFor
----------------------------------------------------------------------------
-- Execute ligo binary itself
-- | Get raw aeson value for ligo scopes.
getLigoScopesRaw
:: LigoClientEnv
-> FilePath
-> Text
-> IO [(Text, LigoTypeFull)]
getLigoTypesFor env contractPath name = do
-> IO Value
getLigoScopesRaw env contractPath = do
output <- callLigo env ["get-scope", contractPath, "--format=json", "--with-types"]
case eitherDecodeStrict' @Value . encodeUtf8 . pack $ output of
Left err -> throwM $ ScopeParseError (pack err)
@ -150,9 +200,33 @@ getLigoTypesFor env contractPath name = do
let variables = scopes ^? key "definitions" . key "variables"
case variables of
Nothing -> throwM $ VariableExtractError scopes
Just variables' -> return $ extractLigoTypesFrom name variables'
Just variables' -> return variables'
-- | Extract a list of types in scopes from aeson @Value@ for some specific declaration.
-- | Extract scoped decls from ligo call.
getLigoScopedDecls
:: LigoClientEnv
-> FilePath
-> IO (HM.HashMap Text ScopedDecl)
getLigoScopedDecls env contractPath = do
scopes <- getLigoScopesRaw env contractPath
let interpreted =
scopes
^@.. members
. (_JSON :: Prism' Value LigoScope)
^. to HM.fromList
return $ toScopedDecl <$> interpreted
-- | Get scopes from ligo compiler and extract a list of types associated with some specific variable.
getLigoTypesFor
:: LigoClientEnv -- ^ Client environment
-> FilePath -- ^ Contract path
-> Text -- ^ Declaration name
-> IO (HM.HashMap Text LigoTypeFull)
getLigoTypesFor env contractPath name = do
scopes <- getLigoScopesRaw env contractPath
return $ HM.fromList $ extractLigoTypesFrom name scopes
-- | Extract a list of types in scopes from aeson @Value@ for some specific declaration under "name" field.
extractLigoTypesFrom :: Text -> Value -> [(Text, LigoTypeFull)]
extractLigoTypesFrom name context =
let current =

131
tools/lsp/squirrel/src/Cli/Json.hs
View File

@ -1,13 +1,16 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric, RecordWildCards #-}
-- | The definition of type as is represented in ligo JSON output
module Cli.Json
( LigoTypeFull (..)
( LigoScope (..)
, LigoTypeFull (..)
, LigoTypeContent (..)
, LigoTypeContentInner (..)
, LigoRecordField (..)
, LigoLocation (..)
, LigoRange (..)
, convertLigoRange
, toScopedDecl
, prepareField
)
where
@ -15,28 +18,41 @@ import Data.Aeson
import Data.Char (isUpper, toLower)
import Data.Foldable (asum, toList)
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import GHC.Generics
import AST.Scope
import Range
----------------------------------------------------------------------------
-- Types
----------------------------------------------------------------------------
data LigoScope = LigoScope
{ _lsName :: Text
, _lsRange :: LigoRange
, _lsBodyRange :: LigoRange
, _lsT :: LigoTypeFull
, _lsReferences :: Value
}
deriving stock (Generic, Show)
-- | Whole ligo type.
-- ```
-- { "t" : LigoTypeFull }
-- ```
data LigoTypeFull = LigoTypeFull
{ -- | Location of the definition.
ltLocation :: LigoLocation
_ltLocation :: LigoRange
, -- | *Some* meta constructors (e.g. `Some`).
ltTypeMeta :: Value
_ltTypeMeta :: Value
, -- | We parse it by a chunks of 2, each odd element of array is a name for
-- even element which is `LigoTypeContentInner`.
-- ```
-- { "type_content": [ <name>, LigoTypeContentInner ] }
-- ```
ltTypeContent :: [LigoTypeContent]
_ltTypeContent :: [LigoTypeContent]
}
deriving stock (Generic, Show)
@ -45,8 +61,8 @@ data LigoTypeFull = LigoTypeFull
-- { "type_content": LigoTypeContent }
-- ```
data LigoTypeContent = LigoTypeContent
{ ltcName :: Text
, ltcContentInner :: LigoTypeContentInner
{ _ltcName :: Text
, _ltcContentInner :: LigoTypeContentInner
}
deriving stock (Generic, Show)
@ -57,15 +73,15 @@ data LigoTypeContent = LigoTypeContent
data LigoTypeContentInner
= -- | Type call represented by the list of arguments and its constructor.
LTCConst
{ ltciArguments :: [Text]
, ltciTypeConst :: Value
{ _ltciArguments :: [Text]
, _ltciTypeConst :: Value
}
| -- | Record type.
LTCRecord (HM.HashMap Text LigoRecordField) -- TODO: continue
| -- | Arrow type, note that the order of its arguments is reversed.
LTCArrow -- "type2" -> "type1"
{ ltcType2 :: LigoTypeFull
, ltcType1 :: LigoTypeFull
{ _ltciType2 :: LigoTypeFull
, _ltciType1 :: LigoTypeFull
}
deriving stock (Generic, Show)
@ -76,27 +92,27 @@ data LigoTypeContentInner
data LigoRecordField = LigoRecordField
{ -- | Declaration position (don't ask me I too don't know what actual
-- position is this since from all the example it's somewhat always 0).
lrfDeclPos :: Int
_lrfDeclPos :: Int
, -- | How the value is represented in michelson, currently ignored
-- during parsing.
lrfMichelsonAnnotation :: Value
_lrfMichelsonAnnotation :: Value
, -- | The type itself.
lrfAssociatedType :: LigoTypeFull
_lrfAssociatedType :: LigoTypeFull
}
deriving stock (Generic, Show)
-- | Location of type definition.
-- ```
-- { "location": LigoLocation }
-- { "location": LigoRange }
-- ```
data LigoLocation
data LigoRange
= Virtual Text
| LigoLocation
{ llFile :: FilePath
, llFromRow :: Int
, llFromCol :: Int
, llToRow :: Int
, llToCol :: Int
| LigoRange
{ _lrFile :: FilePath
, _lrFromRow :: Int
, _lrFromCol :: Int
, _lrToRow :: Int
, _lrToCol :: Int
}
deriving stock (Generic, Show)
@ -104,20 +120,26 @@ data LigoLocation
-- Instances
----------------------------------------------------------------------------
instance FromJSON LigoScope where
parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = prepareField 2}
instance ToJSON LigoScope where
toJSON = genericToJSON defaultOptions {fieldLabelModifier = prepareField 2}
-- TODO: We trust ligo compiler output for printing even number
-- of array elements.
instance FromJSON LigoTypeFull where
parseJSON = withObject "type_full" $ \o -> do
ltLocation <- o .: "location"
_ltLocation <- o .: "location"
type_content <- o .: "type_content"
ltTypeContent <-
_ltTypeContent <-
withArray "type_content" (mapM proceed . group 2 . toList) type_content
ltTypeMeta <- o .: "type_meta"
_ltTypeMeta <- o .: "type_meta"
return $ LigoTypeFull {..}
where
proceed [name, value] = do
ltcName <- parseJSON @Text name
ltcContentInner <- parseJSON @LigoTypeContentInner value
_ltcName <- parseJSON @Text name
_ltcContentInner <- parseJSON @LigoTypeContentInner value
return $ LigoTypeContent {..}
proceed _ = error "number of type content elements is not even and cannot be grouped"
@ -147,20 +169,20 @@ instance FromJSON LigoRecordField where
instance ToJSON LigoRecordField where
toJSON = genericToJSON defaultOptions {fieldLabelModifier = prepareField 3}
instance FromJSON LigoLocation where
instance FromJSON LigoRange where
parseJSON = withObject "location" $ \o ->
asum
[ Virtual <$> o .: "virtual"
, do
llFile <- o .: "file"
llFromRow <- o .: "from_row"
llFromCol <- o .: "from_col"
llToRow <- o .: "to_row"
llToCol <- o .: "to_col"
return $ LigoLocation {..}
_lrFile <- o .: "file"
_lrFromRow <- o .: "from_row"
_lrFromCol <- o .: "from_col"
_lrToRow <- o .: "to_row"
_lrToCol <- o .: "to_col"
return $ LigoRange {..}
]
instance ToJSON LigoLocation where
instance ToJSON LigoRange where
toJSON = genericToJSON defaultOptions {fieldLabelModifier = prepareField 2}
----------------------------------------------------------------------------
@ -169,10 +191,10 @@ instance ToJSON LigoLocation where
-- | Helper function that converts qualified field to its JSON counterpart.
--
-- >>> prepareField 2 "llFooBar"
-- >>> prepareField 2 "__llFooBar"
-- "foo_bar"
prepareField :: Int -> String -> String
prepareField dropAmount = Prelude.drop (dropAmount + 1) . concatMap process
prepareField dropAmount = Prelude.drop (dropAmount + 2) . concatMap process
where
process c
| isUpper c = "_" <> [toLower c]
@ -187,3 +209,34 @@ group _ [] = []
group n l
| n > 0 = (take n l) : (group n (drop n l))
| otherwise = error "Negative or zero n"
-- | Converts ligo ranges to our internal ones.
-- >>> convertLigoRange (LigoRange "test.ligo" 1 2 3 4)
-- [test.ligo:1:2-3:4]
convertLigoRange :: LigoRange -> Maybe Range
convertLigoRange (Virtual _) = Nothing
convertLigoRange LigoRange {..} =
Just
Range
{ rStart = (_lrFromRow, _lrFromCol, 0)
, rFinish = (_lrToRow, _lrToCol, 0)
, rFile = _lrFile
}
-- | Converts ligo scope to our internal one.
-- TODO: convert `LigoTypeFull` to `LIGO ()`
toScopedDecl :: LigoScope -> ScopedDecl
toScopedDecl
LigoScope
{ _lsName = _sdName
, _lsRange = (fromMaybe (error "no origin range") . convertLigoRange -> _sdOrigin)
, _lsBodyRange = (convertLigoRange -> _sdBody)
} =
ScopedDecl
{ _sdName
, _sdOrigin
, _sdBody
, _sdType = Nothing
, _sdRefs = []
, _sdDoc = []
}