Small refactor

This commit is contained in:
Frederik Hanghøj Iversen 2019-10-11 11:37:11 +02:00
parent 21e8747b1f
commit 138b2a7828
3 changed files with 36 additions and 19 deletions

View file

@ -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

View file

@ -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

View file

@ -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 ()