16b0fe8 · Idris-dev · git.iko.soy

main/Main.hs+5−1

compare with master

unifiedsplit

@@ -40,7 +40,11 @@ runIdris opts = do

40 [] -> return ()

41 (c:_) -> do setVerbose False

42 setQuiet True

43− runIO $ runClient (getPort opts) c

43+ case getPort opts of

44+ Just DontListen ->

45+ ifail "\"--client\" and \"--port none\" are incompatible"

46+ Just (ListenPort port) -> runIO $ runClient (Just port) c

47+ Nothing -> runIO $ runClient Nothing c

44 runIO exitSuccess

48 runIO exitSuccess

45

49

46 -- Work with Idris packages.

50 -- Work with Idris packages.

src/Idris/AbsSyntax.hs+4−6

@@ -2632,12 +2632,10 @@ getClient (Client x) = Just x

2632getClient _ = Nothing

2633

2634-- Get the first valid port

2635−getPort :: [Opt] -> Maybe PortID

2635+getPort :: [Opt] -> Maybe REPLPort

2636−getPort [] = Nothing

2636+getPort [] = Nothing

2637−getPort (Port p:xs)

2637+getPort (Port p : xs) = Just p

2638− | all (`elem` ['0'..'9']) p = Just (PortNumber $ fromIntegral (read p))

2639− | otherwise = getPort xs

2640−getPort (_:xs) = getPort xs

2638+getPort (_ : xs) = getPort xs

2641

2639

2642opt :: (Opt -> Maybe a) -> [Opt] -> [a]

2640opt :: (Opt -> Maybe a) -> [Opt] -> [a]

2643opt = mapMaybe

2641opt = mapMaybe

src/Idris/AbsSyntaxTree.hs+5−1

@@ -49,6 +49,7 @@ import Data.Traversable (Traversable)

49import Data.Typeable

50import Data.Foldable (Foldable)

51import GHC.Generics (Generic)

52+import Network.Socket(PortNumber)

52

53

53import Debug.Trace

54import Debug.Trace

54

55

@@ -514,7 +515,7 @@ data Opt = Filename String

514 | ErrContext

515 | ErrContext

515 | ShowImpl

516 | ShowImpl

516 | Verbose

517 | Verbose

517− | Port String -- ^ REPL TCP port

518+ | Port REPLPort -- ^ REPL TCP port

518 | IBCSubDir String

519 | IBCSubDir String

519 | ImportDir String

520 | ImportDir String

520 | SourceDir String

521 | SourceDir String

@@ -553,6 +554,9 @@ data Opt = Filename String

553 | NoOldTacticDeprecationWarnings -- ^ Don't show deprecation warnings for old-style tactics

554 | NoOldTacticDeprecationWarnings -- ^ Don't show deprecation warnings for old-style tactics

554 deriving (Show, Eq, Generic)

555 deriving (Show, Eq, Generic)

555

556

557+data REPLPort = DontListen | ListenPort PortNumber

558+ deriving (Eq, Generic, Show)

559+

556-- Parsed declarations

560-- Parsed declarations

557

561

558data Fixity = Infixl { prec :: Int }

562data Fixity = Infixl { prec :: Int }

src/Idris/CmdOptions.hs+13−1

@@ -23,6 +23,10 @@ import IRTS.CodegenCommon

23

24import Options.Applicative

25import Options.Applicative.Arrows

26+import Options.Applicative.Types (ReadM(..))

27+import Control.Monad.Trans (lift)

28+import Control.Monad.Trans.Reader (ask)

29+import Control.Monad.Trans.Except (throwE)

26import Data.Char

30import Data.Char

27import Data.Maybe

31import Data.Maybe

28

32

@@ -137,7 +141,7 @@ parseFlags = many $

137 <|> flag' WarnOnly (long "warn")

141 <|> flag' WarnOnly (long "warn")

138

142

139 <|> (Pkg <$> strOption (short 'p' <> long "package" <> help "Add package as a dependency"))

143 <|> (Pkg <$> strOption (short 'p' <> long "package" <> help "Add package as a dependency"))

140− <|> (Port <$> strOption (long "port" <> metavar "PORT" <> help "REPL TCP port"))

144+ <|> (Port <$> option portReader (long "port" <> metavar "PORT" <> help "REPL TCP port - pass \"none\" to not bind any port"))

141

145

142 -- Package commands

146 -- Package commands

143 <|> (PkgBuild <$> strOption (long "build" <> metavar "IPKG" <> help "Build package"))

147 <|> (PkgBuild <$> strOption (long "build" <> metavar "IPKG" <> help "Build package"))

@@ -209,6 +213,14 @@ parseFlags = many $

209 getExt s = fromMaybe (error ("Unknown extension " ++ s)) (maybeRead s)

213 getExt s = fromMaybe (error ("Unknown extension " ++ s)) (maybeRead s)

210 maybeRead :: String -> Maybe LanguageExt

214 maybeRead :: String -> Maybe LanguageExt

211 maybeRead = fmap fst . listToMaybe . reads

215 maybeRead = fmap fst . listToMaybe . reads

216+ portReader :: ReadM REPLPort

217+ portReader =

218+ ((ListenPort . fromIntegral) <$> auto) <|>

219+ (ReadM $ do opt <- ask

220+ if map toLower opt == "none"

221+ then return $ DontListen

222+ else lift $ throwE $ ErrorMsg $

223+ "got " <> opt <> " expected port number or \"none\"")

212

224

213parseVersion :: Parser (a -> a)

225parseVersion :: Parser (a -> a)

214parseVersion = infoOption getIdrisVersion (short 'v' <> long "version" <> help "Print version information")

226parseVersion = infoOption getIdrisVersion (short 'v' <> long "version" <> help "Print version information")

src/Idris/DeepSeq.hs+5

@@ -22,6 +22,7 @@ import IRTS.CodegenCommon (OutputType (..))

22import Util.DynamicLinker

23

24import Control.DeepSeq

25+import Network.Socket(PortNumber)

25

26

26import qualified Cheapskate.Types as CT

27import qualified Cheapskate.Types as CT

27import qualified Idris.Docstrings as D

28import qualified Idris.Docstrings as D

@@ -47,6 +48,9 @@ instance NFData DynamicLib where

47instance NFData IdrisColour where

48instance NFData IdrisColour where

48 rnf (IdrisColour _ x2 x3 x4 x5) = rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()

49 rnf (IdrisColour _ x2 x3 x4 x5) = rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()

49

50

51+instance NFData PortNumber where

52+ rnf x = rnf $ show x

53+

50-- Handle doesn't have an NFData instance

54-- Handle doesn't have an NFData instance

51instance NFData OutputMode where

55instance NFData OutputMode where

52 rnf (RawOutput x) = ()

56 rnf (RawOutput x) = ()

@@ -57,6 +61,7 @@ instance NFData ConsoleWidth

57instance NFData PrimFn

61instance NFData PrimFn

58instance NFData SyntaxRules

62instance NFData SyntaxRules

59instance NFData Opt

63instance NFData Opt

64+instance NFData REPLPort

60instance NFData TIData

65instance NFData TIData

61instance NFData IOption

66instance NFData IOption

62instance NFData LanguageExt

67instance NFData LanguageExt

src/Idris/Main.hs+4−2

@@ -108,7 +108,7 @@ idrisMain opts =

108 [expr] -> return (Just expr)

109 let immediate = opt getEvalExpr opts

110 let port = case getPort opts of

111− Nothing -> defaultPort

111+ Nothing -> ListenPort defaultPort

112 Just p -> p

113

114 when (DefaultTotal `elem` opts) $ do i <- getIState

@@ -209,7 +209,9 @@ idrisMain opts =

209

210 when (runrepl && not idesl) $ do

211-- clearOrigPats

212+ case port of

213+ DontListen -> return ()

212− startServer port orig mods

214+ ListenPort port' -> startServer port' orig mods

213 runInputT (replSettings (Just historyFile)) $ repl (force orig) mods efile

215 runInputT (replSettings (Just historyFile)) $ repl (force orig) mods efile

214 let idesock = IdemodeSocket `elem` opts

216 let idesock = IdemodeSocket `elem` opts

215 when (idesl) $ idemodeStart idesock orig inputs

217 when (idesl) $ idemodeStart idesock orig inputs

src/Idris/ModeCommon.hs+3−3

@@ -27,14 +27,14 @@ import Prelude hiding ((<$>), (.), id)

27import System.Directory

28import Control.Monad

29import Control.Monad.Trans.State.Strict (get)

30−import Network (PortID(PortNumber))

30+import Network.Socket (PortNumber)

31import Data.Maybe

32import Data.List hiding (group)

33import Control.DeepSeq

34

35

36−defaultPort :: PortID

36+defaultPort :: PortNumber

37−defaultPort = PortNumber (fromIntegral 4294)

37+defaultPort = fromIntegral 4294

38

39

40loadInputs :: [FilePath] -> Maybe Int -> Idris [FilePath]

src/Idris/REPL.hs+3−3

@@ -154,7 +154,7 @@ repl orig mods efile

154 else show n

155

156-- | Run the REPL server

157−startServer :: PortID -> IState -> [FilePath] -> Idris ()

157+startServer :: PortNumber -> IState -> [FilePath] -> Idris ()

158startServer port orig fn_in = do tid <- runIO $ forkIO (serverLoop port)

159 return ()

160 where serverLoop port = withSocketsDo $

@@ -213,10 +213,10 @@ processNetCmd orig i h fn cmd

213 IdeMode n _ -> ist {idris_outputmode = IdeMode n h}

214

215-- | Run a command on the server on localhost

216−runClient :: Maybe PortID -> String -> IO ()

216+runClient :: Maybe PortNumber -> String -> IO ()

217runClient port str = withSocketsDo $ do

218 let port' = fromMaybe defaultPort port

219− res <- X.try (connectTo "localhost" port')

219+ res <- X.try (connectTo "localhost" $ PortNumber port')

220 case res of

221 Right h -> do

222 hSetEncoding h utf8

src/Util/Net.hs+4−2

@@ -8,13 +8,14 @@ Maintainer : The Idris Community.

8module Util.Net (listenOnLocalhost, listenOnLocalhostAnyPort) where

9

10import Network hiding (socketPort)

11−import Network.Socket hiding (sClose, PortNumber)

11+import Network.Socket hiding (sClose)

12import Network.BSD (getProtocolNumber)

13import Control.Exception (bracketOnError)

14

15-- Copied from upstream impl of listenOn

16-- bound to localhost interface instead of iNADDR_ANY

17−listenOnLocalhost (PortNumber port) = do

17+listenOnLocalhost :: PortNumber -> IO Socket

18+listenOnLocalhost port = do

18 proto <- getProtocolNumber "tcp"

19 proto <- getProtocolNumber "tcp"

19 localhost <- inet_addr "127.0.0.1"

20 localhost <- inet_addr "127.0.0.1"

20 bracketOnError

21 bracketOnError

@@ -27,6 +28,7 @@ listenOnLocalhost (PortNumber port) = do

27 return sock

28 return sock

28 )

29 )

29

30

31+listenOnLocalhostAnyPort :: IO (Socket, PortNumber)

30listenOnLocalhostAnyPort = do

32listenOnLocalhostAnyPort = do

31 proto <- getProtocolNumber "tcp"

33 proto <- getProtocolNumber "tcp"

32 localhost <- inet_addr "127.0.0.1"

34 localhost <- inet_addr "127.0.0.1"