09271cd · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Merge pull request #528 from 5outh/master

Kind querying in psci

commit09271cde67f608763916ea5984fedd3e5e5a6984 authorPhil Freeman <paf31@cantab.net> dateSat 2 Aug 2014, 16:07 (12 years ago) parent8b3ec69 3acff62

4 files changed+49−1

compare with golang

unifiedsplit

.gitignore+1 psci/Commands.hs+5 psci/Main.hs+35 psci/Parser.hs+8−1

.gitignore+1

@@ -8,3 +8,4 @@ cabal.sandbox.config

88*.chs.h

99*.lksh*

1010.virthualenv

11+.psci_modules/

psci/Commands.hs+5

@@ -53,6 +53,10 @@ data Command

5353 -- Find the type of an expression

5454 --

5555 | TypeOf Value

56+ -- |

57+ -- Find the kind of an expression

58+ --

59+ | KindOf Type

5660

5761-- |

5862-- The help menu.

@@ -65,4 +69,5 @@ help =

6569 , [":q ", "Quit PSCi"]

6670 , [":r ", "Reset"]

6771 , [":t <expr> ", "Show the type of <expr>"]

72+ , [":k <type> ", "Show the kind of <type>"]

6873 ]

psci/Main.hs+35

@@ -24,6 +24,7 @@ import Control.Monad

2424import Control.Monad.Trans.Class

2525import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

2626import Control.Monad.Trans.State.Strict

27+import qualified Control.Monad.Trans.State.Lazy as L

2728import Control.Monad.Error (ErrorT(..), MonadError)

2829import Control.Monad.Error.Class (MonadError(..))

2930

@@ -256,6 +257,18 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

256257 in

257258 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

258259

260+-- |

261+-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.

262+--

263+createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module

264+createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =

265+ let

266+ moduleName = P.ModuleName [P.ProperName "Main"]

267+ importDecl m = P.ImportDeclaration m Nothing Nothing

268+ itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ

269+ in

270+ P.Module moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing

271+

259272modulesDir :: FilePath

260273modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"

261274

@@ -296,6 +309,27 @@ handleTypeOf value = do

296309 Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty

297310 Nothing -> PSCI $ outputStrLn "Could not find type"

298311

312+-- |

313+-- Takes a value and prints its kind

314+--

315+handleKindOf :: P.Type -> PSCI ()

316+handleKindOf typ = do

317+ st <- PSCI $ lift get

318+ let m = createTemporaryModuleForKind st typ

319+ mName = P.ModuleName [P.ProperName "Main"]

320+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])

321+ case e of

322+ Left err -> PSCI $ outputStrLn err

323+ Right env' ->

324+ case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of

325+ Just (_, typ') -> do

326+ let chk = P.CheckState env' 0 0 (Just mName)

327+ k = L.runStateT (P.unCheck (P.kindOf mName typ')) chk

328+ case k of

329+ Left errStack -> PSCI . outputStrLn . P.prettyPrintErrorStack False $ errStack

330+ Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind

331+ Nothing -> PSCI $ outputStrLn "Could not find kind"

332+

299333-- Commands

300334

301335-- |

@@ -339,6 +373,7 @@ handleCommand Reset = do

339373 Left err -> psciIO $ putStrLn err >> exitFailure

340374 Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])

341375handleCommand (TypeOf val) = handleTypeOf val

376+handleCommand (KindOf typ) = handleKindOf typ

342377handleCommand _ = PSCI $ outputStrLn "Unknown command"

343378

344379inputFiles :: Cmd.Term [FilePath]

psci/Parser.hs+8−1

@@ -42,7 +42,7 @@ psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C

4242--

4343parseCommand :: String -> Either ParseError Command

4444parseCommand = P.runIndentParser "" $ choice

4646 , try psciLet

4747 , psciExpression

4848 ] <* eof

@@ -90,3 +90,10 @@ psciReload = Reset <$ char 'r'

9090--

9191psciTypeOf :: Parsec String P.ParseState Command

9292psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)

93+

94+

95+-- |

96+-- Parses 'Commands.KindOf' command.

97+--

98+psciKindOf :: Parsec String P.ParseState Command

99+psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)