git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #528 from 5outh/master
09271cdPhil Freeman
.gitignore+1
compare with golang
unifiedsplit
@@ -8,3 +8,4 @@ cabal.sandbox.config
8*.chs.h
8*.chs.h
9*.lksh*
9*.lksh*
10.virthualenv
10.virthualenv
11+.psci_modules/
psci/Commands.hs+5
@@ -53,6 +53,10 @@ data Command
53 -- Find the type of an expression
53 -- Find the type of an expression
54 --
54 --
55 | TypeOf Value
55 | TypeOf Value
56+ -- |
57+ -- Find the kind of an expression
58+ --
59+ | KindOf Type
56
60
57-- |
61-- |
58-- The help menu.
62-- The help menu.
@@ -65,4 +69,5 @@ help =
65 , [":q ", "Quit PSCi"]
69 , [":q ", "Quit PSCi"]
66 , [":r ", "Reset"]
70 , [":r ", "Reset"]
67 , [":t <expr> ", "Show the type of <expr>"]
71 , [":t <expr> ", "Show the type of <expr>"]
72+ , [":k <type> ", "Show the kind of <type>"]
68 ]
73 ]
psci/Main.hs+35
@@ -24,6 +24,7 @@ import Control.Monad
24import Control.Monad.Trans.Class
24import Control.Monad.Trans.Class
25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
26import Control.Monad.Trans.State.Strict
26import Control.Monad.Trans.State.Strict
27+import qualified Control.Monad.Trans.State.Lazy as L
27import Control.Monad.Error (ErrorT(..), MonadError)
28import Control.Monad.Error (ErrorT(..), MonadError)
28import Control.Monad.Error.Class (MonadError(..))
29import Control.Monad.Error.Class (MonadError(..))
29
30
@@ -256,6 +257,18 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB
256 in
257 in
257 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing
258 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing
258
259
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+
259modulesDir :: FilePath
272modulesDir :: FilePath
260modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
273modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
261
274
@@ -296,6 +309,27 @@ handleTypeOf value = do
296 Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
309 Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
297 Nothing -> PSCI $ outputStrLn "Could not find type"
310 Nothing -> PSCI $ outputStrLn "Could not find type"
298
311
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+
299-- Commands
333-- Commands
300
334
301-- |
335-- |
@@ -339,6 +373,7 @@ handleCommand Reset = do
339 Left err -> psciIO $ putStrLn err >> exitFailure
373 Left err -> psciIO $ putStrLn err >> exitFailure
340 Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])
374 Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])
341handleCommand (TypeOf val) = handleTypeOf val
375handleCommand (TypeOf val) = handleTypeOf val
376+handleCommand (KindOf typ) = handleKindOf typ
342handleCommand _ = PSCI $ outputStrLn "Unknown command"
377handleCommand _ = PSCI $ outputStrLn "Unknown command"
343
378
344inputFiles :: Cmd.Term [FilePath]
379inputFiles :: 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
42--
42--
43parseCommand :: String -> Either ParseError Command
43parseCommand :: String -> Either ParseError Command
44parseCommand = P.runIndentParser "" $ choice
44parseCommand = P.runIndentParser "" $ choice
45− [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf)
45+ [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf)
46 , try psciLet
46 , try psciLet
47 , psciExpression
47 , psciExpression
48 ] <* eof
48 ] <* eof
@@ -90,3 +90,10 @@ psciReload = Reset <$ char 'r'
90--
90--
91psciTypeOf :: Parsec String P.ParseState Command
91psciTypeOf :: Parsec String P.ParseState Command
92psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)
92psciTypeOf = 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)