Make infoOf always return an info

This commit is contained in:
Kirill Andreev 2020-06-04 16:34:58 +04:00
parent 9b95006a71
commit 1f7af3c8cb
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
2 changed files with 11 additions and 14 deletions

View File

@ -45,8 +45,8 @@ newtype Env = Env
deriving newtype (Semigroup, Monoid) deriving newtype (Semigroup, Monoid)
data ScopedDecl = ScopedDecl data ScopedDecl = ScopedDecl
{ _sdName :: Maybe (Pascal ()) { _sdName :: (Pascal ())
, _sdOrigin :: Maybe Range , _sdOrigin :: Range
, _sdBody :: Maybe Range , _sdBody :: Maybe Range
, _sdType :: Maybe (Either (Pascal ()) Kind) , _sdType :: Maybe (Either (Pascal ()) Kind)
} }
@ -73,9 +73,9 @@ define = define_ method
defType :: HasRange a => Pascal a -> Kind -> Pascal a -> ScopeM () defType :: HasRange a => Pascal a -> Kind -> Pascal a -> ScopeM ()
defType name kind body = do defType name kind body = do
define $ ScopedDecl define $ ScopedDecl
(Just (void name)) (void name)
(getRange <$> infoOf name) (getRange $ infoOf name)
(getRange <$> infoOf body) (Just $ getRange $ infoOf body)
(Just (Right kind)) (Just (Right kind))
def def
@ -86,9 +86,9 @@ def
-> ScopeM () -> ScopeM ()
def name ty body = do def name ty body = do
define $ ScopedDecl define $ ScopedDecl
(Just (void name)) (void name)
(getRange <$> infoOf name) (getRange $ infoOf name)
(getRange <$> do infoOf =<< body) ((getRange . infoOf) <$> body)
((Left . void) <$> ty) ((Left . void) <$> ty)
instance UpdateOver ScopeM Contract (Pascal a) instance UpdateOver ScopeM Contract (Pascal a)
@ -337,6 +337,6 @@ evalScopeM action = evalState action [Env []]
testUpdate :: Pascal ASTInfo -> ScopeM (Pascal Scope) testUpdate :: Pascal ASTInfo -> ScopeM (Pascal Scope)
testUpdate = updateTree \_ -> do testUpdate = updateTree \_ -> do
Env topmost <- gets head Env topmost <- gets head
let names = catMaybes $ _sdName <$> topmost let names = _sdName <$> topmost
let res = ppToText $ fsep $ map pp names let res = ppToText $ fsep $ map pp names
return $ Scope res return $ Scope res

View File

@ -121,11 +121,8 @@ mk :: (Functor f, Member f fs) => info -> f (Tree fs info) -> Tree fs info
mk i fx = Tree $ Fix $ Compose $ Right $ Compose (i, inj $ fmap unTree fx) mk i fx = Tree $ Fix $ Compose $ Right $ Compose (i, inj $ fmap unTree fx)
-- | Get info from the tree. -- | Get info from the tree.
infoOf :: Tree fs info -> Maybe info infoOf :: Tree fs info -> info
infoOf (Tree (Fix (Compose it))) = infoOf = either eInfo (fst . getCompose) . getCompose . unFix . unTree
either
(const Nothing)
(Just . fst . getCompose) it
instance Stubbed (Tree fs info) info where instance Stubbed (Tree fs info) info where
stub = Tree . Fix . Compose . Left stub = Tree . Fix . Compose . Left