Simplify application
a bit
This commit is contained in:
parent
4463077e55
commit
6b3eaeb737
|
@ -104,7 +104,7 @@ deriving newtype instance ToJSON Context
|
||||||
|
|
||||||
class Monad m => MyMonad (m :: Type -> Type) where
|
class Monad m => MyMonad (m :: Type -> Type) where
|
||||||
declaration :: Node -> m ()
|
declaration :: Node -> m ()
|
||||||
application :: Node -> Node -> m ()
|
application :: Node -> m ()
|
||||||
getContext :: m Context
|
getContext :: m Context
|
||||||
writeContext :: Context -> m ()
|
writeContext :: Context -> m ()
|
||||||
|
|
||||||
|
@ -131,10 +131,12 @@ instance MyMonad (State Env) where
|
||||||
where
|
where
|
||||||
go :: Env -> Env
|
go :: Env -> Env
|
||||||
go env@Env{declarations} = env { declarations = Set.insert q declarations }
|
go env@Env{declarations} = env { declarations = Set.insert q declarations }
|
||||||
application q n = modify go
|
application n = do
|
||||||
where
|
Context c <- getContext
|
||||||
go :: Env -> Env
|
let
|
||||||
go env@Env{applications} = env { applications = Map.insertWith mappend q (Set.singleton n) applications }
|
go env@Env{applications}
|
||||||
|
= env { applications = Map.insertWith mappend c (Set.singleton n) applications }
|
||||||
|
modify go
|
||||||
getContext = gets context
|
getContext = gets context
|
||||||
writeContext q = modify go
|
writeContext q = modify go
|
||||||
where
|
where
|
||||||
|
@ -206,8 +208,7 @@ instance References Ruby.Anything where
|
||||||
entries = const $ pure ()
|
entries = const $ pure ()
|
||||||
|
|
||||||
instance References Ruby.Namespace where
|
instance References Ruby.Namespace where
|
||||||
entries = \case
|
entries (Ruby.Namespace xs) = do
|
||||||
Ruby.Namespace xs -> do
|
|
||||||
Context c <- getContext
|
Context c <- getContext
|
||||||
let
|
let
|
||||||
ctxt = case c of
|
ctxt = case c of
|
||||||
|
@ -217,7 +218,7 @@ instance References Ruby.Namespace where
|
||||||
ns = Namespace ((\(Name (Aeson.String t)) -> t) <$> xs)
|
ns = Namespace ((\(Name (Aeson.String t)) -> t) <$> xs)
|
||||||
-- TODO: Broken
|
-- TODO: Broken
|
||||||
-- application c (NodeModule $ ctxt `onTop` ns)
|
-- application c (NodeModule $ ctxt `onTop` ns)
|
||||||
application c (NodeModule $ ns)
|
application (NodeModule $ ns)
|
||||||
|
|
||||||
instance References Module where
|
instance References Module where
|
||||||
entries Module{name, block} = do
|
entries Module{name, block} = do
|
||||||
|
@ -256,14 +257,9 @@ onTop (Namespace xs) (Namespace ys) = Namespace $ reverse $ reverse xs `onTop'`
|
||||||
|
|
||||||
instance References Send where
|
instance References Send where
|
||||||
entries Send{namespace, name} = do
|
entries Send{namespace, name} = do
|
||||||
Context c <- getContext
|
|
||||||
let
|
|
||||||
ctxt = case c of
|
|
||||||
NodeFunction FQN{namespace = ns} -> ns
|
|
||||||
NodeModule ns -> ns
|
|
||||||
-- TODO: Broken
|
-- TODO: Broken
|
||||||
-- application c $ NodeFunction $ qual (ctxt `onTop` fromNS namespace) name
|
-- application c $ NodeFunction $ qual (ctxt `onTop` fromNS namespace) name
|
||||||
application c $ NodeFunction $ qual (fromNS namespace) name
|
application $ NodeFunction $ qual (fromNS namespace) name
|
||||||
where
|
where
|
||||||
fromNS :: Ruby.Namespace -> Namespace
|
fromNS :: Ruby.Namespace -> Namespace
|
||||||
fromNS (Ruby.Namespace l) = Namespace $ go <$> l
|
fromNS (Ruby.Namespace l) = Namespace $ go <$> l
|
||||||
|
|
Loading…
Reference in a new issue