github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-27 12:57:49 +03:00
Code Issues Projects Releases Wiki Activity

Return the root node.

Browse Source
This commit is contained in:
Rob Rix 2022-02-07 10:37:48 -05:00
parent 4f102fc8f5
commit befb3e2366
No known key found for this signature in database
GPG Key ID: 2BE643E01DC032AE
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
semantic-analysis/src/Analysis/Syntax.hs
View File

@ -43,6 +43,7 @@ import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.Function (fix) import Data.Function (fix)
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import Data.Monoid (First(..))
import Data.Text (Text, pack, unpack) import Data.Text (Text, pack, unpack)
import qualified Data.Vector as V import qualified Data.Vector as V
@ -140,28 +141,29 @@ let' n v m = do
-- Parsing -- Parsing
parseFile :: Syntax rep => FilePath -> IO (Either (A.JSONPath, String) (IntMap.IntMap rep)) parseFile :: Syntax rep => FilePath -> IO (Either (A.JSONPath, String) (Maybe rep))
parseFile path = do parseFile path = do
contents <- B.readFile path contents <- B.readFile path
pure $ A.eitherDecodeWith A.json' (A.iparse parseGraph) contents pure $ snd <$> A.eitherDecodeWith A.json' (A.iparse parseGraph) contents
parseGraph :: Syntax rep => A.Value -> A.Parser (IntMap.IntMap rep) parseGraph :: Syntax rep => A.Value -> A.Parser (IntMap.IntMap rep, Maybe rep)
parseGraph = A.withArray "nodes" $ \ nodes -> do parseGraph = A.withArray "nodes" $ \ nodes -> do
untied <- IntMap.fromList <$> traverse (A.withObject "node" parseNode) (V.toList nodes) (untied, First root) <- foldMap (\ (k, v, r) -> ([(k, v)], First r)) <$> traverse (A.withObject "node" parseNode) (V.toList nodes)
pure $ fix (\ tied -> ($ tied) . either id id <$> untied) let tied = fix (\ tied -> ($ tied) <$> IntMap.fromList untied)
pure (tied, root)
parseNode :: Syntax rep => A.Object -> A.Parser (IntMap.Key, Either (IntMap.IntMap rep -> rep) (IntMap.IntMap rep -> rep)) parseNode :: Syntax rep => A.Object -> A.Parser (IntMap.Key, IntMap.IntMap rep -> rep, Maybe rep)
parseNode o = do parseNode o = do
edges <- o A..: pack "edges" edges <- o A..: pack "edges"
index <- o A..: pack "id" index <- o A..: pack "id"
let parseType attrs = attrs A..: pack "type" >>= \case let parseType attrs = attrs A..: pack "type" >>= \case
"string" -> Left . const . string <$> attrs A..: pack "text" "string" -> const . string <$> attrs A..: pack "text"
"true" -> pure (Left (const (bool True))) "true" -> pure (const (bool True))
"false" -> pure (Left (const (bool False))) "false" -> pure (const (bool False))
"throw" -> Left . fmap throw <$> resolve (head edges) "throw" -> fmap throw <$> resolve (head edges)
"if" -> (\ c t e -> Left (liftA3 iff c t e)) <$> findEdgeNamed "condition" <*> findEdgeNamed "consequence" <*> findEdgeNamed "alternative" <|> pure (Left (const noop)) "if" -> liftA3 iff <$> findEdgeNamed "condition" <*> findEdgeNamed "consequence" <*> findEdgeNamed "alternative" <|> pure (const noop)
"block" -> Left . fmap (foldr (\ (i, v) r -> let_ (nameI i) v (const r)) noop . zip [0..]) . sequenceA <$> traverse resolve edges "block" -> fmap (foldr (\ (i, v) r -> let_ (nameI i) v (const r)) noop . zip [0..]) . sequenceA <$> traverse resolve edges
"module" -> Right . fmap (foldr (\ (i, v) r -> let_ (nameI i) v (const r)) noop . zip [0..]) . sequenceA <$> traverse resolve edges "module" -> fmap (foldr (\ (i, v) r -> let_ (nameI i) v (const r)) noop . zip [0..]) . sequenceA <$> traverse resolve edges
t -> A.parseFail ("unrecognized type: " <> t) t -> A.parseFail ("unrecognized type: " <> t)
resolve = resolveWith (const (pure ())) resolve = resolveWith (const (pure ()))
resolveWith :: (A.Object -> A.Parser ()) -> A.Value -> A.Parser (IntMap.IntMap rep -> rep) resolveWith :: (A.Object -> A.Parser ()) -> A.Value -> A.Parser (IntMap.IntMap rep -> rep)
@ -171,4 +173,4 @@ parseNode o = do
f attrs f attrs
pure (IntMap.! sink)) pure (IntMap.! sink))
findEdgeNamed name = foldMap (resolveWith (\ attrs -> attrs A..: pack "type" >>= guard . (== name))) edges findEdgeNamed name = foldMap (resolveWith (\ attrs -> attrs A..: pack "type" >>= guard . (== name))) edges
o A..: pack "attrs" >>= A.withObject "attrs" (fmap (index,) . parseType) o A..: pack "attrs" >>= A.withObject "attrs" (fmap (index,,Nothing) . parseType)