120b53c · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge pull request #3346 from jfdm/collate-info

Collate 'info' about idris setup.

commit120b53c3d5f4899cb38f7ac5fc203b1030d58412 authorJan de Muijnck-Hughes <jfdm@users.noreply.github.com> dateSun 7 Aug 2016, 19:05 (10 years ago) parentce81257 c96148c

5 files changed+87−28

compare with master

unifiedsplit

idris.cabal+1 main/Main.hs+4−8 src/Idris/CmdOptions.hs+3−2 src/Idris/Info.hs+66 src/Idris/REPL.hs+13−18

idris.cabal+1

@@ -188,6 +188,7 @@ Library

188188 , Idris.IdeMode

189189 , Idris.IdrisDoc

190190 , Idris.Imports

191+ , Idris.Info

191192 , Idris.Inliner

192193 , Idris.Interactive

193194 , Idris.Output

main/Main.hs+4−8

@@ -9,10 +9,10 @@ import Idris.REPL

99import Idris.Imports

1010import Idris.Error

1111import Idris.CmdOptions

12−

12+import Idris.Info

1313import Idris.Package

1414

15−import IRTS.System ( getLibFlags, getIdrisLibDir, getIncFlags )

15+

1616

1717import Util.System ( setupBundledCC )

1818

@@ -62,12 +62,8 @@ runIdris opts = do

6262 _ -> ifail "Too many packages"

6363 fs -> runIO $ mapM_ (buildPkg opts (WarnOnly `elem` opts)) fs

6464

65−showver :: IO b

66−showver = do putStrLn $ "Idris version " ++ ver

67− exitSuccess

68−

6965showLibs :: IO b

70−showLibs = do libFlags <- getLibFlags

66+showLibs = do libFlags <- getIdrisFlagsLib

7167 putStrLn $ unwords libFlags

7268 exitSuccess

7369

@@ -76,7 +72,7 @@ showLibdir = do putStrLn =<< getIdrisLibDir

7672 exitSuccess

7773

7874showIncs :: IO b

79−showIncs = do incFlags <- getIncFlags

75+showIncs = do incFlags <- getIdrisFlagsInc

8076 putStrLn $ unwords incFlags

8177 exitSuccess

8278

src/Idris/CmdOptions.hs+3−2

@@ -10,6 +10,7 @@ module Idris.CmdOptions where

1010

1111import Idris.AbsSyntaxTree

1212import Idris.REPL

13+import Idris.Info (getIdrisVersion)

1314

1415import IRTS.CodegenCommon

1516

@@ -33,7 +34,7 @@ runArgParser = do opts <- execParser $ info parser

3334 )

3435 return $ preProcOpts opts

3536 where

36− idrisHeader = PP.hsep [PP.text "Idris version", PP.text ver, PP.text ", (C) The Idris Community 2016"]

37+ idrisHeader = PP.hsep [PP.text "Idris version", PP.text getIdrisVersion, PP.text ", (C) The Idris Community 2016"]

3738 idrisProgDesc = PP.vsep [PP.empty,

3839 PP.text "Idris is a general purpose pure functional programming language with dependent",

3940 PP.text "types. Dependent types allow types to be predicated on values, meaning that",

@@ -201,7 +202,7 @@ parseFlags = many $

201202 maybeRead = fmap fst . listToMaybe . reads

202203

203204parseVersion :: Parser (a -> a)

204−parseVersion = infoOption ver (short 'v' <> long "version" <> help "Print version information")

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

205206

206207preProcOpts :: [Opt] -> [Opt]

207208preProcOpts (NoBuiltins : xs) = NoBuiltins : NoPrelude : preProcOpts xs

src/Idris/Info.hsnew file+66

@@ -0,0 +1,66 @@

1+{-|

2+Module : Idris.Info

3+Description : Get information about Idris.

4+Copyright : 2016 The Idris Community

5+License : BSD3

6+Maintainer : The Idris Community.

7+-}

8+module Idris.Info

9+ ( getIdrisLibDir

10+ , getIdrisFlagsLib

11+ , getIdrisFlagsInc

12+ , getIdrisFlagsEnv

13+ , getIdrisCC

14+ , getIdrisVersion

15+ , getIdrisVersionNoGit

16+ , getIdrisUserDataDir

17+ , getIdrisInitScript

18+ , getIdrisHistoryFile

19+ ) where

20+

21+import System.FilePath

22+import System.Directory

23+import Data.Version

24+

25+import qualified IRTS.System as S

26+

27+import Version_idris (gitHash)

28+

29+import Paths_idris

30+

31+getIdrisLibDir :: IO String

32+getIdrisLibDir = S.getIdrisLibDir

33+

34+getIdrisFlagsLib :: IO [String]

35+getIdrisFlagsLib = S.getLibFlags

36+

37+getIdrisFlagsInc :: IO [String]

38+getIdrisFlagsInc = S.getIncFlags

39+

40+getIdrisFlagsEnv :: IO [String]

41+getIdrisFlagsEnv = S.getEnvFlags

42+

43+getIdrisCC :: IO String

44+getIdrisCC = S.getCC

45+

46+getIdrisVersion = showVersion S.version ++ suffix

47+ where

48+ suffix = if gitHash =="" then "" else "-" ++ gitHash

49+

50+getIdrisVersionNoGit = S.version

51+

52+

53+-- | Get the platform-specific, user-specific Idris dir

54+getIdrisUserDataDir :: IO FilePath

55+getIdrisUserDataDir = getAppUserDataDirectory "idris"

56+

57+-- | Locate the platform-specific location for the init script

58+getIdrisInitScript :: IO FilePath

59+getIdrisInitScript = do

60+ idrisDir <- getIdrisUserDataDir

61+ return $ idrisDir </> "repl" </> "init"

62+

63+getIdrisHistoryFile :: IO FilePath

64+getIdrisHistoryFile = do

65+ udir <- getIdrisUserDataDir

66+ return (udir </> "repl" </> "history")

src/Idris/REPL.hs+13−18

@@ -12,7 +12,7 @@ module Idris.REPL(

1212 getClient, getPkg, getPkgCheck, getPkgClean, getPkgMkDoc

1313 , getPkgREPL, getPkgTest, getPort, getIBCSubDir

1414 , idris, idrisMain, loadInputs

15− , opt, runClient, runMain, ver

15+ , opt, runClient, runMain

1616 ) where

1717

1818import Idris.AbsSyntax

@@ -55,6 +55,8 @@ import Idris.Elab.Data

5555import Idris.Elab.Value

5656import Idris.Elab.Term

5757

58+import Idris.Info

59+

5860import Version_idris (gitHash)

5961import Util.System

6062import Util.DynamicLinker

@@ -71,7 +73,7 @@ import Idris.Core.Constraints

7173import IRTS.Compiler

7274import IRTS.CodegenCommon

7375import IRTS.Exports

74−import IRTS.System

76+--import IRTS.System

7577

7678import Control.Category

7779import qualified Control.Exception as X

@@ -567,7 +569,7 @@ runIdeModeCommand h id orig fn modes (IdeMode.ErrPPrint e) =

567569 msg = (IdeMode.SymbolAtom "ok", out, spans)

568570 runIO . hPutStrLn h $ IdeMode.convSExp "return" msg id

569571runIdeModeCommand h id orig fn modes IdeMode.GetIdrisVersion =

570− let idrisVersion = (versionBranch version,

572+ let idrisVersion = (versionBranch getIdrisVersionNoGit,

571573 if not (null gitHash)

572574 then [gitHash]

573575 else [])

@@ -1472,7 +1474,7 @@ showTotalN ist n = case lookupTotal n (tt_ctxt ist) of

14721474 showN n = annotate (AnnName n Nothing Nothing Nothing) . text $

14731475 showName (Just ist) [] ppo False n

14741476

1475−displayHelp = let vstr = showVersion version in

1477+displayHelp = let vstr = showVersion getIdrisVersionNoGit in

14761478 "\nIdris version " ++ vstr ++ "\n" ++

14771479 "--------------" ++ map (\x -> '-') vstr ++ "\n\n" ++

14781480 concatMap cmdInfo helphead ++

@@ -1799,13 +1801,13 @@ idrisMain opts =

17991801 Just expr -> execScript expr

18001802

18011803 -- Create Idris data dir + repl history and config dir

1802− idrisCatch (do dir <- getIdrisUserDataDir

1804+ idrisCatch (do dir <- runIO $ getIdrisUserDataDir

18031805 exists <- runIO $ doesDirectoryExist dir

18041806 unless exists $ logLvl 1 ("Creating " ++ dir)

18051807 runIO $ createDirectoryIfMissing True (dir </> "repl"))

18061808 (\e -> return ())

18071809

1808− historyFile <- fmap (</> "repl" </> "history") getIdrisUserDataDir

1810+ historyFile <- runIO $ getIdrisHistoryFile

18091811

18101812 when ok $ case opt getPkgIndex opts of

18111813 (f : _) -> writePkgIndex f

@@ -1850,18 +1852,10 @@ execScript expr = do i <- getIState

18501852 res <- execute tm

18511853 runIO $ exitSuccess

18521854

1853−-- | Get the platform-specific, user-specific Idris dir

1854−getIdrisUserDataDir :: Idris FilePath

1855−getIdrisUserDataDir = runIO $ getAppUserDataDirectory "idris"

1856−

1857−-- | Locate the platform-specific location for the init script

1858−getInitScript :: Idris FilePath

1859−getInitScript = do idrisDir <- getIdrisUserDataDir

1860− return $ idrisDir </> "repl" </> "init"

18611855

18621856-- | Run the initialisation script

18631857initScript :: Idris ()

1864−initScript = do script <- getInitScript

1858+initScript = do script <- runIO $ getIdrisInitScript

18651859 idrisCatch (do go <- runIO $ doesFileExist script

18661860 when go $ do

18671861 h <- runIO $ openFile script ReadMode

@@ -1873,7 +1867,7 @@ initScript = do script <- getInitScript

18731867 ist <- getIState

18741868 unless eof $ do

18751869 line <- runIO $ hGetLine h

1876− script <- getInitScript

1870+ script <- runIO $ getIdrisInitScript

18771871 c <- colourise

18781872 processLine ist line script c

18791873 runInit h

@@ -2011,16 +2005,17 @@ getPort (_:xs) = getPort xs

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

20122006opt = mapMaybe

20132007

2008+{-

20142009ver = showVersion version ++ suffix

20152010 where

20162011 suffix = if gitHash =="" then "" else "-" ++ gitHash

2017−

2012+-}

20182013defaultPort :: PortID

20192014defaultPort = PortNumber (fromIntegral 4294)

20202015

20212016banner = " ____ __ _ \n" ++

20222017 " / _/___/ /____(_)____ \n" ++

2023− " / // __ / ___/ / ___/ Version " ++ ver ++ "\n" ++

2018+ " / // __ / ___/ / ___/ Version " ++ getIdrisVersion ++ "\n" ++

20242019 " _/ // /_/ / / / (__ ) http://www.idris-lang.org/ \n" ++

20252020 " /___/\\__,_/_/ /_/____/ Type :? for help \n" ++

20262021 "\n" ++