Small refactor
This commit is contained in:
parent
21e8747b1f
commit
138b2a7828
12
ruby/test.rb
12
ruby/test.rb
|
@ -3,17 +3,21 @@ module M
|
||||||
end
|
end
|
||||||
|
|
||||||
def g
|
def g
|
||||||
|
|
||||||
f(2)
|
f(2)
|
||||||
h(2, a: 'a')
|
h(2, a: 'a')
|
||||||
h(2, a: :a)
|
h(2, a: :a)
|
||||||
|
end
|
||||||
|
|
||||||
|
module N
|
||||||
|
def f
|
||||||
|
g
|
||||||
|
end
|
||||||
|
|
||||||
|
def g
|
||||||
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
# class C
|
|
||||||
# end
|
|
||||||
|
|
||||||
module K
|
module K
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -12,11 +12,6 @@ import System.Environment (getArgs)
|
||||||
import System.Process (readProcess)
|
import System.Process (readProcess)
|
||||||
import qualified Data.ByteString.Lazy.Char8 as ByteString
|
import qualified Data.ByteString.Lazy.Char8 as ByteString
|
||||||
import Rubyhs.References (references)
|
import Rubyhs.References (references)
|
||||||
import qualified Rubyhs.References as References
|
|
||||||
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
|
|
||||||
import Data.Text.Prettyprint.Doc (layoutCompact)
|
|
||||||
import Data.HashMap.Strict (HashMap)
|
|
||||||
import GHC.Exts (fromList, toList)
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = getArgs >>= traverse_ run
|
main = getArgs >>= traverse_ run
|
||||||
|
@ -25,13 +20,7 @@ run :: FilePath -> IO ()
|
||||||
run p = do
|
run p = do
|
||||||
json <- runParser p
|
json <- runParser p
|
||||||
block <- decodeFail @_ @Block $ ByteString.pack json
|
block <- decodeFail @_ @Block $ ByteString.pack json
|
||||||
ByteString.putStrLn $ encode block
|
ByteString.putStrLn $ encode $ references block
|
||||||
let References.Env{declarations, applications} = references block
|
|
||||||
printEm declarations
|
|
||||||
printEm applications
|
|
||||||
where
|
|
||||||
go (x, y) = (renderStrict $ layoutCompact $ pretty x, y)
|
|
||||||
printEm x = ByteString.putStrLn $ encode $ fromList @(HashMap _ _) $ go <$> toList x
|
|
||||||
|
|
||||||
decodeFail :: MonadFail m => FromJSON a => ByteString -> m a
|
decodeFail :: MonadFail m => FromJSON a => ByteString -> m a
|
||||||
decodeFail s = case eitherDecode s of
|
decodeFail s = case eitherDecode s of
|
||||||
|
|
|
@ -6,6 +6,7 @@ module Rubyhs.References
|
||||||
, FQN(..)
|
, FQN(..)
|
||||||
, references
|
, references
|
||||||
, Env(..)
|
, Env(..)
|
||||||
|
, Result(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Frelude
|
import Frelude
|
||||||
|
@ -14,14 +15,19 @@ import Data.Map (Map)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Kind
|
import Data.Kind
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Data.Aeson ((.=))
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.HashMap.Strict (HashMap)
|
||||||
|
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
|
||||||
|
import Data.Text.Prettyprint.Doc (layoutCompact)
|
||||||
|
|
||||||
data Entry a = Entry
|
data Entry a = Entry
|
||||||
{ node :: a
|
{ node :: a
|
||||||
, fqn :: FQN
|
, fqn :: FQN
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- Names are in reverse order.
|
||||||
newtype FQN = FQN ([] Name)
|
newtype FQN = FQN ([] Name)
|
||||||
|
|
||||||
deriving stock instance Show FQN
|
deriving stock instance Show FQN
|
||||||
|
@ -36,7 +42,7 @@ instance IsList FQN where
|
||||||
fromList l = FQN $ fromList l
|
fromList l = FQN $ fromList l
|
||||||
toList (FQN l) = toList l
|
toList (FQN l) = toList l
|
||||||
instance Pretty FQN where
|
instance Pretty FQN where
|
||||||
pretty = pretty . intercalate "::" . fmap go . toList
|
pretty = pretty . intercalate "::" . fmap go . reverse . toList
|
||||||
where
|
where
|
||||||
go (Name (Aeson.Array [_, _, Aeson.String n])) = convertString n
|
go (Name (Aeson.Array [_, _, Aeson.String n])) = convertString n
|
||||||
go x = show x
|
go x = show x
|
||||||
|
@ -56,6 +62,20 @@ data Env = Env
|
||||||
, context :: FQN
|
, context :: FQN
|
||||||
}
|
}
|
||||||
|
|
||||||
|
data Result = Result
|
||||||
|
{ declarations :: Map FQN [Name]
|
||||||
|
, applications :: Map FQN [Name]
|
||||||
|
}
|
||||||
|
instance ToJSON Result where
|
||||||
|
toJSON Result{declarations,applications} = Aeson.object
|
||||||
|
[ "declarations" .= f declarations
|
||||||
|
, "applications" .= f applications
|
||||||
|
]
|
||||||
|
where
|
||||||
|
f :: Map FQN [Name] -> HashMap Text [Name]
|
||||||
|
f x = fromList $ go <$> toList x
|
||||||
|
go (x, y) = (renderStrict $ layoutCompact $ pretty x, y)
|
||||||
|
|
||||||
instance Semigroup Env where
|
instance Semigroup Env where
|
||||||
Env a0 a1 a2 <> Env b0 b1 b2 = Env (a0 <> b0) (a1 <> b1) (a2 <> b2)
|
Env a0 a1 a2 <> Env b0 b1 b2 = Env (a0 <> b0) (a1 <> b1) (a2 <> b2)
|
||||||
|
|
||||||
|
@ -65,9 +85,11 @@ instance Monoid Env where
|
||||||
instance MyMonad (State Env) where
|
instance MyMonad (State Env) where
|
||||||
declaration q n = modify go
|
declaration q n = modify go
|
||||||
where
|
where
|
||||||
|
go :: Env -> Env
|
||||||
go env@Env{declarations} = env { declarations = Map.insertWith mappend q (pure n) declarations }
|
go env@Env{declarations} = env { declarations = Map.insertWith mappend q (pure n) declarations }
|
||||||
application q n = modify go
|
application q n = modify go
|
||||||
where
|
where
|
||||||
|
go :: Env -> Env
|
||||||
go env@Env{applications} = env { applications = Map.insertWith mappend q (pure n) applications }
|
go env@Env{applications} = env { applications = Map.insertWith mappend q (pure n) applications }
|
||||||
getContext = gets context
|
getContext = gets context
|
||||||
writeContext q = modify go
|
writeContext q = modify go
|
||||||
|
@ -92,8 +114,10 @@ appendToContext n = updateContext go
|
||||||
class References a where
|
class References a where
|
||||||
entries :: MyMonad m => a -> m ()
|
entries :: MyMonad m => a -> m ()
|
||||||
|
|
||||||
references :: Block -> Env
|
references :: Block -> Result
|
||||||
references q = execState (entries @_ @(State Env) q) mempty
|
references q = Result{declarations, applications}
|
||||||
|
where
|
||||||
|
Env{declarations,applications} = execState (entries @_ @(State Env) q) mempty
|
||||||
|
|
||||||
instance References Block where
|
instance References Block where
|
||||||
entries :: forall m . MyMonad m => Block -> m ()
|
entries :: forall m . MyMonad m => Block -> m ()
|
||||||
|
|
Loading…
Reference in a new issue