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

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #3346 from jfdm/collate-info

120b53cJan de Muijnck-Hughes10 years ago

idris.cabal+1

compare with master

unifiedsplit

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

188 , Idris.IdeMode

189 , Idris.IdrisDoc

190 , Idris.Imports

191+ , Idris.Info

191 , Idris.Inliner

192 , Idris.Inliner

192 , Idris.Interactive

193 , Idris.Interactive

193 , Idris.Output

194 , Idris.Output

main/Main.hs+4−8

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

9import Idris.Imports

10import Idris.Error

11import Idris.CmdOptions

12−

12+import Idris.Info

13import Idris.Package

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

15+

17import Util.System ( setupBundledCC )

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

62 _ -> ifail "Too many packages"

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

65−showver :: IO b

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

67− exitSuccess

68−

69showLibs :: IO b

65showLibs :: IO b

70−showLibs = do libFlags <- getLibFlags

66+showLibs = do libFlags <- getIdrisFlagsLib

71 putStrLn $ unwords libFlags

67 putStrLn $ unwords libFlags

72 exitSuccess

68 exitSuccess

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

76 exitSuccess

72 exitSuccess

78showIncs :: IO b

74showIncs :: IO b

79−showIncs = do incFlags <- getIncFlags

75+showIncs = do incFlags <- getIdrisFlagsInc

80 putStrLn $ unwords incFlags

76 putStrLn $ unwords incFlags

81 exitSuccess

77 exitSuccess

src/Idris/CmdOptions.hs+3−2

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

11import Idris.AbsSyntaxTree

12import Idris.REPL

13+import Idris.Info (getIdrisVersion)

14import IRTS.CodegenCommon

15import IRTS.CodegenCommon

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

33 )

34 )

34 return $ preProcOpts opts

35 return $ preProcOpts opts

35 where

36 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"]

37 idrisProgDesc = PP.vsep [PP.empty,

38 idrisProgDesc = PP.vsep [PP.empty,

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

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

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

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

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

201 maybeRead = fmap fst . listToMaybe . reads

202 maybeRead = fmap fst . listToMaybe . reads

202

203

203parseVersion :: Parser (a -> a)

204parseVersion :: 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")

205

206

206preProcOpts :: [Opt] -> [Opt]

207preProcOpts :: [Opt] -> [Opt]

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

208preProcOpts (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(

12 getClient, getPkg, getPkgCheck, getPkgClean, getPkgMkDoc

13 , getPkgREPL, getPkgTest, getPort, getIBCSubDir

14 , idris, idrisMain, loadInputs

15− , opt, runClient, runMain, ver

15+ , opt, runClient, runMain

16 ) where

18import Idris.AbsSyntax

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

55import Idris.Elab.Value

56import Idris.Elab.Term

58+import Idris.Info

59+

58import Version_idris (gitHash)

60import Version_idris (gitHash)

59import Util.System

61import Util.System

60import Util.DynamicLinker

62import Util.DynamicLinker

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

71import IRTS.Compiler

73import IRTS.Compiler

72import IRTS.CodegenCommon

74import IRTS.CodegenCommon

73import IRTS.Exports

75import IRTS.Exports

74−import IRTS.System

76+--import IRTS.System

76import Control.Category

78import Control.Category

77import qualified Control.Exception as X

79import qualified Control.Exception as X

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

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

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

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

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

569runIdeModeCommand h id orig fn modes IdeMode.GetIdrisVersion =

571runIdeModeCommand h id orig fn modes IdeMode.GetIdrisVersion =

570− let idrisVersion = (versionBranch version,

572+ let idrisVersion = (versionBranch getIdrisVersionNoGit,

571 if not (null gitHash)

573 if not (null gitHash)

572 then [gitHash]

574 then [gitHash]

573 else [])

575 else [])

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

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

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

1473 showName (Just ist) [] ppo False n

1475 showName (Just ist) [] ppo False n

1474

1476

1475−displayHelp = let vstr = showVersion version in

1477+displayHelp = let vstr = showVersion getIdrisVersionNoGit in

1476 "\nIdris version " ++ vstr ++ "\n" ++

1478 "\nIdris version " ++ vstr ++ "\n" ++

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

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

1478 concatMap cmdInfo helphead ++

1480 concatMap cmdInfo helphead ++

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

1799 Just expr -> execScript expr

1801 Just expr -> execScript expr

1800

1802

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

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

1802− idrisCatch (do dir <- getIdrisUserDataDir

1804+ idrisCatch (do dir <- runIO $ getIdrisUserDataDir

1803 exists <- runIO $ doesDirectoryExist dir

1805 exists <- runIO $ doesDirectoryExist dir

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

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

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

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

1806 (\e -> return ())

1808 (\e -> return ())

1807

1809

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

1810+ historyFile <- runIO $ getIdrisHistoryFile

1809

1811

1810 when ok $ case opt getPkgIndex opts of

1812 when ok $ case opt getPkgIndex opts of

1811 (f : _) -> writePkgIndex f

1813 (f : _) -> writePkgIndex f

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

1850 res <- execute tm

1852 res <- execute tm

1851 runIO $ exitSuccess

1853 runIO $ exitSuccess

1852

1854

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"

1861

1855

1862-- | Run the initialisation script

1856-- | Run the initialisation script

1863initScript :: Idris ()

1857initScript :: Idris ()

1864−initScript = do script <- getInitScript

1858+initScript = do script <- runIO $ getIdrisInitScript

1865 idrisCatch (do go <- runIO $ doesFileExist script

1859 idrisCatch (do go <- runIO $ doesFileExist script

1866 when go $ do

1860 when go $ do

1867 h <- runIO $ openFile script ReadMode

1861 h <- runIO $ openFile script ReadMode

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

1873 ist <- getIState

1867 ist <- getIState

1874 unless eof $ do

1868 unless eof $ do

1875 line <- runIO $ hGetLine h

1869 line <- runIO $ hGetLine h

1876− script <- getInitScript

1870+ script <- runIO $ getIdrisInitScript

1877 c <- colourise

1871 c <- colourise

1878 processLine ist line script c

1872 processLine ist line script c

1879 runInit h

1873 runInit h

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

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

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

2012opt = mapMaybe

2006opt = mapMaybe

2013

2007

2008+{-

2014ver = showVersion version ++ suffix

2009ver = showVersion version ++ suffix

2015 where

2010 where

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

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

2017−

2012+-}

2018defaultPort :: PortID

2013defaultPort :: PortID

2019defaultPort = PortNumber (fromIntegral 4294)

2014defaultPort = PortNumber (fromIntegral 4294)

2020

2015

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

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

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

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

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

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

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

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

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

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

2026 "\n" ++

2021 "\n" ++