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
def g
f(2)
h(2, a: 'a')
h(2, a: :a)
end
module N
def f
g
end
def g
end
end
end
# class C
# end
module K
end

View file

@ -12,11 +12,6 @@ import System.Environment (getArgs)
import System.Process (readProcess)
import qualified Data.ByteString.Lazy.Char8 as ByteString
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 = getArgs >>= traverse_ run
@ -25,13 +20,7 @@ run :: FilePath -> IO ()
run p = do
json <- runParser p
block <- decodeFail @_ @Block $ ByteString.pack json
ByteString.putStrLn $ encode 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
ByteString.putStrLn $ encode $ references block
decodeFail :: MonadFail m => FromJSON a => ByteString -> m a
decodeFail s = case eitherDecode s of

View file

@ -6,6 +6,7 @@ module Rubyhs.References
, FQN(..)
, references
, Env(..)
, Result(..)
) where
import Frelude
@ -14,14 +15,19 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Kind
import Control.Monad.State
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
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
{ node :: a
, fqn :: FQN
}
-- Names are in reverse order.
newtype FQN = FQN ([] Name)
deriving stock instance Show FQN
@ -36,7 +42,7 @@ instance IsList FQN where
fromList l = FQN $ fromList l
toList (FQN l) = toList l
instance Pretty FQN where
pretty = pretty . intercalate "::" . fmap go . toList
pretty = pretty . intercalate "::" . fmap go . reverse . toList
where
go (Name (Aeson.Array [_, _, Aeson.String n])) = convertString n
go x = show x
@ -56,6 +62,20 @@ data Env = Env
, 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
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
declaration q n = modify go
where
go :: Env -> Env
go env@Env{declarations} = env { declarations = Map.insertWith mappend q (pure n) declarations }
application q n = modify go
where
go :: Env -> Env
go env@Env{applications} = env { applications = Map.insertWith mappend q (pure n) applications }
getContext = gets context
writeContext q = modify go
@ -92,8 +114,10 @@ appendToContext n = updateContext go
class References a where
entries :: MyMonad m => a -> m ()
references :: Block -> Env
references q = execState (entries @_ @(State Env) q) mempty
references :: Block -> Result
references q = Result{declarations, applications}
where
Env{declarations,applications} = execState (entries @_ @(State Env) q) mempty
instance References Block where
entries :: forall m . MyMonad m => Block -> m ()