/
Args.hs
103 lines (88 loc) · 3.46 KB
/
Args.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
{-# LANGUAGE Arrows, CPP #-}
module Args (getArgs) where
import Control.Arrow
import Util.Args
import System.Directory (getCurrentDirectory)
import System.FilePath (splitPath)
import Types
#ifdef cabal
import Util.Cabal (prettyVersion)
import Paths_hsenv (version)
versionString :: String
versionString = prettyVersion version
#else
versionString :: String
versionString = "dev"
#endif
verbosityOpt, veryVerbosityOpt, skipSanityOpt, sharingOpt :: Switch
verbosityOpt = Switch { switchName = "verbose"
, switchHelp = "Print some debugging info"
, switchShort = Just 'v'
}
veryVerbosityOpt = Switch { switchName = "very-verbose"
, switchHelp = "Print some more debugging info"
, switchShort = Nothing
}
skipSanityOpt = Switch { switchName = "skip-sanity-check"
, switchHelp = "Skip all the sanity checks (use at your own risk)"
, switchShort = Nothing
}
sharingOpt = Switch { switchName = "dont-share-cabal-cache"
, switchHelp = "Don't share ~/.cabal/packages (hackage download cache)"
, switchShort = Nothing
}
nameOpt, ghcOpt :: DynOpt
nameOpt = DynOpt
{ dynOptName = "name"
, dynOptTemplate = "NAME"
, dynOptDescription = "current directory name"
, dynOptHelp = "Use NAME as name of the Virtual Haskell Environment"
}
ghcOpt = DynOpt
{ dynOptName = "ghc"
, dynOptTemplate = "FILE"
, dynOptDescription = "system's copy of GHC"
, dynOptHelp =
"Use GHC from provided tarball (e.g. ghc-7.0.4-i386-unknown-linux.tar.bz2)"
}
makeOpt :: StaticOpt
makeOpt = StaticOpt
{ staticOptName = "make-cmd"
, staticOptTemplate = "CMD"
, staticOptDefault = "make"
, staticOptHelp =
"Used as make substitute for installing GHC from tarball (e.g. gmake)"
}
argParser :: ArgArrow () Options
argParser = proc () -> do
verbosityFlag <- getOpt verbosityOpt -< ()
verbosityFlag2 <- getOpt veryVerbosityOpt -< ()
let verboseness = case (verbosityFlag, verbosityFlag2) of
(_, True) -> VeryVerbose
(True, False) -> Verbose
(False, False) -> Quiet
nameFlag <- getOpt nameOpt -< ()
name <- case nameFlag of
Just name' -> returnA -< name'
Nothing -> do
cwd <- liftIO' getCurrentDirectory -< ()
returnA -< last $ splitPath cwd
ghcFlag <- getOpt ghcOpt -< ()
let ghc = case ghcFlag of
Nothing -> System
Just path -> Tarball path
skipSanityCheckFlag <- getOpt skipSanityOpt -< ()
noSharingFlag <- getOpt sharingOpt -< ()
make <- getOpt makeOpt -< ()
returnA -< Options{ verbosity = verboseness
, skipSanityCheck = skipSanityCheckFlag
, hsEnvName = name
, ghcSource = ghc
, makeCmd = make
, noSharing = noSharingFlag
}
where liftIO' = liftIO . const
getArgs :: IO Options
getArgs = parseArgs argParser versionString outro
where outro = "Creates Virtual Haskell Environment in the current directory.\n"
++ "All files will be stored in the .hsenv_ENVNAME/ subdirectory."