6eb1982 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Move from cmdtheline to optparse-applicative #690

6eb1982Anthony Quizon12 years ago

hierarchy/Main.hs+32−22

compare with golang

unifiedsplit

@@ -15,25 +15,30 @@

16module Main where

18−import Control.Applicative ((<*>), (<$>))

19import Control.Monad (unless)

18import Control.Monad (unless)

21import Data.List (intercalate,nub,sort)

20import Data.List (intercalate,nub,sort)

22import Data.Foldable (for_)

21import Data.Foldable (for_)

23import Data.Version (showVersion)

22import Data.Version (showVersion)

25−import System.Console.CmdTheLine

24+import Options.Applicative

26import System.Directory (createDirectoryIfMissing)

25import System.Directory (createDirectoryIfMissing)

27import System.FilePath ((</>))

26import System.FilePath ((</>))

28import System.Exit (exitFailure, exitSuccess)

27import System.Exit (exitFailure, exitSuccess)

29import System.IO (stderr)

28import System.IO (stderr)

31−import Text.Parsec (ParseError)

30+import Text.Parsec as Par (ParseError)

33import qualified Language.PureScript as P

32import qualified Language.PureScript as P

34import qualified Paths_purescript as Paths

33import qualified Paths_purescript as Paths

35import qualified System.IO.UTF8 as U

34import qualified System.IO.UTF8 as U

36+

37+data HierarchyOptions = HierarchyOptions

38+ { hierachyInput :: FilePath

39+ , hierarchyOutput :: Maybe FilePath

40+ }

41+

37newtype SuperMap = SuperMap { unSuperMap :: Either P.ProperName (P.ProperName, P.ProperName) }

42newtype SuperMap = SuperMap { unSuperMap :: Either P.ProperName (P.ProperName, P.ProperName) }

38 deriving Eq

43 deriving Eq

@@ -49,13 +54,13 @@ instance Ord SuperMap where

49runModuleName :: P.ModuleName -> String

54runModuleName :: P.ModuleName -> String

50runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

55runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

52−readInput :: FilePath -> IO (Either ParseError [P.Module])

57+readInput :: FilePath -> IO (Either Par.ParseError [P.Module])

53readInput p = do

58readInput p = do

54 text <- U.readFile p

59 text <- U.readFile p

55 return $ P.runIndentParser p P.parseModules text

60 return $ P.runIndentParser p P.parseModules text

57−compile :: FilePath -> Maybe FilePath -> IO ()

62+compile :: HierarchyOptions -> IO ()

58−compile input mOutput = do

63+compile (HierarchyOptions input mOutput) = do

59 modules <- readInput input

64 modules <- readInput input

60 case modules of

65 case modules of

61 Left err -> U.hPutStr stderr (show err) >> exitFailure

66 Left err -> U.hPutStr stderr (show err) >> exitFailure

@@ -82,23 +87,28 @@ superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]

82superClasses (P.PositionedDeclaration _ decl) = superClasses decl

87superClasses (P.PositionedDeclaration _ decl) = superClasses decl

83superClasses _ = []

88superClasses _ = []

85−outputFile :: Term (Maybe FilePath)

90+inputFile :: Parser FilePath

86−outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])

91+inputFile = strArgument $

87− { optDoc = "The output directory" }

92+ metavar "FILE"

93+ <> value "main.purs"

94+ <> showDefault

95+ <> help "The input file to generate a hierarchy from"

89−inputFile :: Term FilePath

97+outputFile :: Parser (Maybe FilePath)

90−inputFile = value $ pos 0 "main.purs" $ posInfo

98+outputFile = optional . strOption $

91− { posDoc = "The input file to generate a hierarchy from" }

99+ short 'o'

100+ <> long "output"

101+ <> help "The output directory"

102

93−term :: Term (IO ())

103+pscOptions :: Parser HierarchyOptions

104+pscOptions = HierarchyOptions <$> inputFile

94−term = compile <$> inputFile <*> outputFile

105+ <*> outputFile

95−

96−termInfo :: TermInfo

97−termInfo = defTI

98− { termName = "hierarchy"

99− , version = showVersion Paths.version

100− , termDoc = "Creates a GraphViz directed graph of PureScript TypeClasses"

101− }

102

106

103main :: IO ()

107main :: IO ()

104−main = run (term, termInfo)

108+main = execParser opts >>= compile

109+ where

110+ opts = info (helper <*> pscOptions) infoModList

111+ infoModList = fullDesc <> headerInfo <> footerInfo

112+ headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"

113+ footerInfo = footer $ "hierarchy " ++ showVersion Paths.version

114+

psc-docs/Main.hs+30−17

@@ -22,15 +22,24 @@ import Data.Function (on)

22import Data.List

23import Data.Maybe (fromMaybe)

24import Data.Version (showVersion)

25+

26+import Options.Applicative

27+

25import qualified Language.PureScript as P

28import qualified Language.PureScript as P

26import qualified Paths_purescript as Paths

29import qualified Paths_purescript as Paths

27import qualified System.IO.UTF8 as U

30import qualified System.IO.UTF8 as U

28−import System.Console.CmdTheLine

29import System.Exit (exitSuccess, exitFailure)

31import System.Exit (exitSuccess, exitFailure)

30import System.IO (stderr)

32import System.IO (stderr)

32−docgen :: Bool -> [FilePath] -> IO ()

34+

35+data PSCDocsOptions = PSCDocsOptions

36+ { pscdIncludeHeir :: Bool

37+ , pscdInputFiles :: [FilePath]

38+ }

39+

40+

41+docgen :: PSCDocsOptions -> IO ()

33−docgen showHierarchy input = do

42+docgen (PSCDocsOptions showHierarchy input) = do

34 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)

43 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)

35 case e of

44 case e of

36 Left err -> do

45 Left err -> do

@@ -218,21 +227,25 @@ isTypeInstanceDeclaration P.TypeInstanceDeclaration{} = True

218isTypeInstanceDeclaration (P.PositionedDeclaration _ d) = isTypeInstanceDeclaration d

227isTypeInstanceDeclaration (P.PositionedDeclaration _ d) = isTypeInstanceDeclaration d

219isTypeInstanceDeclaration _ = False

228isTypeInstanceDeclaration _ = False

220

229

221−inputFiles :: Term [FilePath]

230+inputFile :: Parser FilePath

222−inputFiles = value $ posAny [] $ posInfo { posName = "file(s)", posDoc = "The input .purs file(s)" }

231+inputFile = strArgument $

223−

232+ metavar "FILE"

224−includeHeirarcy :: Term Bool

233+ <> help "The input .ps file(s)"

225−includeHeirarcy = value $ flag $ (optInfo [ "h", "hierarchy-images" ]) { optDoc = "Include markdown for type class hierarchy images in the output." }

226

234

227−term :: Term (IO ())

235+includeHeirarcy :: Parser Bool

228−term = docgen <$> includeHeirarcy <*> inputFiles

236+includeHeirarcy = switch $

237+ long "hierarchy-images"

238+ <> help "Include markdown for type class hierarchy images in the output."

229

239

230−termInfo :: TermInfo

240+pscDocsOptions :: Parser PSCDocsOptions

231−termInfo = defTI

241+pscDocsOptions = PSCDocsOptions <$> includeHeirarcy

232− { termName = "psc-docs"

242+ <*> many inputFile

233− , version = showVersion Paths.version

234− , termDoc = "Generate Markdown documentation from PureScript extern files"

235− }

236

243

237main :: IO ()

244main :: IO ()

238−main = run (term, termInfo)

245+main = execParser opts >>= docgen

246+ where

247+ opts = info (helper <*> pscDocsOptions) infoModList

248+ infoModList = fullDesc <> headerInfo <> footerInfo

249+ headerInfo = header "psc-docs - Generate Markdown documentation from PureScript extern files"

250+ footerInfo = footer $ "psc-docs " ++ showVersion Paths.version

251+

psc-make/Main.hs+77−49

@@ -21,7 +21,8 @@ import Control.Monad.Error

22import Data.Version (showVersion)

24−import System.Console.CmdTheLine

24+import Options.Applicative as Opts

25+

25import System.Directory

26import System.Directory

26 (doesFileExist, getModificationTime, createDirectoryIfMissing)

27 (doesFileExist, getModificationTime, createDirectoryIfMissing)

27import System.FilePath (takeDirectory)

28import System.FilePath (takeDirectory)

@@ -32,6 +33,14 @@ import qualified Language.PureScript as P

32import qualified Paths_purescript as Paths

33import qualified Paths_purescript as Paths

33import qualified System.IO.UTF8 as U

34import qualified System.IO.UTF8 as U

36+

37+data PSCMakeOptions = PSCMakeOptions

38+ { pscmInput :: [FilePath]

39+ , pscmOutputDir :: FilePath

40+ , pscmOpts :: P.Options P.Make

41+ , pscmUsePrefix :: Bool

42+ }

43+

35data InputOptions = InputOptions

44data InputOptions = InputOptions

36 { ioNoPrelude :: Bool

45 { ioNoPrelude :: Bool

37 , ioInputFiles :: [FilePath]

46 , ioInputFiles :: [FilePath]

@@ -39,7 +48,7 @@ data InputOptions = InputOptions

40readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]

49readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]

41readInput InputOptions{..} = do

50readInput InputOptions{..} = do

42− content <- forM ioInputFiles $ \inputFile -> (Right inputFile, ) <$> U.readFile inputFile

51+ content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> U.readFile inFile

43 return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)

52 return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)

45newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)

54newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)

@@ -66,8 +75,8 @@ instance P.MonadMake Make where

66 liftError = either throwError return

75 liftError = either throwError return

67 progress = makeIO . U.putStrLn

76 progress = makeIO . U.putStrLn

69−compile :: [FilePath] -> FilePath -> P.Options P.Make -> Bool -> IO ()

78+compile :: PSCMakeOptions -> IO ()

70−compile input outputDir opts usePrefix = do

79+compile (PSCMakeOptions input outputDir opts usePrefix) = do

71 modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)

80 modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)

72 case modules of

81 case modules of

73 Left err -> do

82 Left err -> do

@@ -89,51 +98,70 @@ compile input outputDir opts usePrefix = do

89mkdirp :: FilePath -> IO ()

98mkdirp :: FilePath -> IO ()

90mkdirp = createDirectoryIfMissing True . takeDirectory

99mkdirp = createDirectoryIfMissing True . takeDirectory

100

92−inputFiles :: Term [FilePath]

101+inputFile :: Parser FilePath

93−inputFiles = value $ posAny [] $ posInfo

102+inputFile = strArgument $

103+ metavar "FILE"

94− { posDoc = "The input .ps files" }

104+ <> help "The input .ps file(s)"

95−

105+

96−outputDirectory :: Term FilePath

106+outputDirectory :: Parser FilePath

97−outputDirectory = value $ opt "output" $ (optInfo [ "o", "output" ])

107+outputDirectory = strOption $

108+ short 'o'

109+ <> long "output"

98− { optDoc = "The output directory" }

110+ <> help "The output directory"

99−

111+

100−noTco :: Term Bool

112+noTco :: Parser Bool

101−noTco = value $ flag $ (optInfo [ "no-tco" ])

113+noTco = switch $

114+ long "no-tco"

102− { optDoc = "Disable tail call optimizations" }

115+ <> help "Disable tail call optimizations"

103−

116+

104−noPrelude :: Term Bool

117+noPrelude :: Parser Bool

105−noPrelude = value $ flag $ (optInfo [ "no-prelude" ])

118+noPrelude = switch $

119+ long "no-prelude"

106− { optDoc = "Omit the Prelude" }

120+ <> help "Omit the Prelude"

107−

121+

108−noMagicDo :: Term Bool

122+noMagicDo :: Parser Bool

109−noMagicDo = value $ flag $ (optInfo [ "no-magic-do" ])

123+noMagicDo = switch $

124+ long "no-magic-do"

110− { optDoc = "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad." }

125+ <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."

111−

126+

112−noOpts :: Term Bool

127+noOpts :: Parser Bool

113−noOpts = value $ flag $ (optInfo [ "no-opts" ])

128+noOpts = switch $

129+ long "no-opts"

114− { optDoc = "Skip the optimization phase." }

130+ <> help "Skip the optimization phase."

115−

131+

116−verboseErrors :: Term Bool

132+verboseErrors :: Parser Bool

117−verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

133+verboseErrors = switch $

134+ short 'v'

135+ <> long "no-opts"

118− { optDoc = "Display verbose error messages" }

136+ <> help "Display verbose error messages"

119−

137+

120−options :: Term (P.Options P.Make)

121−options = P.Options <$> noPrelude <*> noTco <*> noMagicDo <*> pure Nothing <*> noOpts <*> verboseErrors <*> pure P.MakeOptions

122−

123−noPrefix :: Term Bool

138+noPrefix :: Parser Bool

124−noPrefix = value $ flag $ (optInfo ["p", "no-prefix" ])

139+noPrefix = switch $

140+ short 'p'

141+ <> long "no-prefix"

125− { optDoc = "Do not include comment header"}

142+ <> help "Do not include comment header"

126−

143+

127−term :: Term (IO ())

144+

128−term = compile <$> inputFiles <*> outputDirectory <*> options <*> (not <$> noPrefix)

145+options :: Parser (P.Options P.Make)

129−

146+options = P.Options <$> noPrelude

130−termInfo :: TermInfo

147+ <*> noTco

131−termInfo = defTI

148+ <*> noMagicDo

132− { termName = "psc-make"

149+ <*> pure Nothing

133− , version = showVersion Paths.version

150+ <*> noOpts

134− , termDoc = "Compiles PureScript to Javascript"

151+ <*> verboseErrors

135− }

152+ <*> pure P.MakeOptions

153+

154+pscMakeOptions :: Parser PSCMakeOptions

155+pscMakeOptions = PSCMakeOptions <$> many inputFile

156+ <*> outputDirectory

157+ <*> options

158+ <*> (not <$> noPrefix)

136

159

137main :: IO ()

160main :: IO ()

138−main = run (term, termInfo)

161+main = execParser opts >>= compile

162+ where

163+ opts = info (helper <*> pscMakeOptions) infoModList

164+ infoModList = fullDesc <> headerInfo <> footerInfo

165+ headerInfo = header "psc-make - Compiles PureScript to Javascript"

166+ footerInfo = footer $ "psc-make " ++ showVersion Paths.version

139

167

psc/Main.hs+125−75

@@ -22,7 +22,7 @@ import Control.Monad.Error

22import Data.Maybe (fromMaybe)

23import Data.Version (showVersion)

25−import System.Console.CmdTheLine

25+import Options.Applicative as Opts

26import System.Directory (createDirectoryIfMissing)

27import System.FilePath (takeDirectory)

28import System.Exit (exitSuccess, exitFailure)

@@ -32,6 +32,16 @@ import qualified Language.PureScript as P

32import qualified Paths_purescript as Paths

33import qualified System.IO.UTF8 as U

35+

36+data PSCOptions = PSCOptions

37+ { pscInput :: [FilePath]

38+ , pscOpts :: P.Options P.Compile

39+ , pscStdIn :: Bool

40+ , pscOutput :: Maybe FilePath

41+ , pscExterns :: Maybe FilePath

42+ , pscUsePrefix :: Bool

43+ }

44+

35data InputOptions = InputOptions

45data InputOptions = InputOptions

36 { ioNoPrelude :: Bool

46 { ioNoPrelude :: Bool

37 , ioUseStdIn :: Bool

47 , ioUseStdIn :: Bool

@@ -41,11 +51,11 @@ data InputOptions = InputOptions

41readInput :: InputOptions -> IO [(Maybe FilePath, String)]

51readInput :: InputOptions -> IO [(Maybe FilePath, String)]

42readInput InputOptions{..}

52readInput InputOptions{..}

43 | ioUseStdIn = return . (Nothing ,) <$> getContents

53 | ioUseStdIn = return . (Nothing ,) <$> getContents

44− | otherwise = do content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile

54+ | otherwise = do content <- forM ioInputFiles $ \inFile -> (Just inFile, ) <$> U.readFile inFile

45 return (if ioNoPrelude then content else (Nothing, P.prelude) : content)

55 return (if ioNoPrelude then content else (Nothing, P.prelude) : content)

47−compile :: P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()

57+compile :: PSCOptions -> IO ()

48−compile opts stdin input output externs usePrefix = do

58+compile (PSCOptions input opts stdin output externs usePrefix) = do

49 modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)

59 modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)

50 case modules of

60 case modules of

51 Left err -> do

61 Left err -> do

@@ -72,78 +82,118 @@ compile opts stdin input output externs usePrefix = do

72mkdirp :: FilePath -> IO ()

82mkdirp :: FilePath -> IO ()

73mkdirp = createDirectoryIfMissing True . takeDirectory

83mkdirp = createDirectoryIfMissing True . takeDirectory

75−useStdIn :: Term Bool

85+codeGenModule :: Parser String

76−useStdIn = value . flag $ (optInfo [ "s", "stdin" ])

86+codeGenModule = strOption $

77− { optDoc = "Read from standard input" }

87+ long "codegen"

78−

88+ <> help "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times."

79−inputFiles :: Term [FilePath]

89+

80−inputFiles = value $ posAny [] $ posInfo

90+dceModule :: Parser String

81− { posDoc = "The input .ps files" }

91+dceModule = strOption $

82−

92+ short 'm'

83−outputFile :: Term (Maybe FilePath)

93+ <> long "module"

84−outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])

85− { optDoc = "The output .js file" }

86−

87−externsFile :: Term (Maybe FilePath)

88−externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])

89− { optDoc = "The output .e.ps file" }

90−

91−noTco :: Term Bool

92−noTco = value $ flag $ (optInfo [ "no-tco" ])

93− { optDoc = "Disable tail call optimizations" }

94−

95−noPrelude :: Term Bool

96−noPrelude = value $ flag $ (optInfo [ "no-prelude" ])

97− { optDoc = "Omit the Prelude" }

98−

99−noMagicDo :: Term Bool

100−noMagicDo = value $ flag $ (optInfo [ "no-magic-do" ])

101− { optDoc = "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad." }

102−

103−runMain :: Term (Maybe String)

104−runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])

105− { optDoc = "Generate code to run the main method in the specified module." }

106−

107−noOpts :: Term Bool

108−noOpts = value $ flag $ (optInfo [ "no-opts" ])

109− { optDoc = "Skip the optimization phase." }

110−

111−browserNamespace :: Term String

112−browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])

113− { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }

114−

115−dceModules :: Term [String]

116−dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])

117− { optDoc = "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times." }

94+ <> help "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times."

118−

95+

119−codeGenModules :: Term [String]

96+browserNamespace :: Parser String

120−codeGenModules = value $ optAll [] $ (optInfo [ "codegen" ])

97+browserNamespace = strOption $

121− { optDoc = "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times." }

98+ long "browser-namespace"

122−

99+ <> Opts.value "PS"

100+ <> showDefault

101+ <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."

102+

123−verboseErrors :: Term Bool

103+verboseErrors :: Parser Bool

124−verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

104+verboseErrors = switch $

105+ short 'v'

106+ <> long "no-opts"

125− { optDoc = "Display verbose error messages" }

107+ <> help "Display verbose error messages"

126−

108+

127−noPrefix :: Term Bool

109+noOpts :: Parser Bool

128−noPrefix = value $ flag $ (optInfo ["no-prefix" ])

110+noOpts = switch $

129− { optDoc = "Do not include comment header"}

111+ long "no-opts"

130−

112+ <> help "Skip the optimization phase."

131−options :: Term (P.Options P.Compile)

113+

132−options = P.Options <$> noPrelude <*> noTco <*> noMagicDo <*> runMain <*> noOpts <*> verboseErrors <*> additionalOptions

114+runMain :: Parser (Maybe String)

115+runMain = optional $ noArgs <|> withArgs

133 where

116 where

117+ defaultVal = "Main"

118+ noArgs = flag' defaultVal (long "main")

119+ withArgs = strOption $

120+ long "main"

121+ <> help (concat [

122+ "Generate code to run the main method in the specified module. ",

123+ "(no argument: \"", defaultVal, "\")"

124+ ])

125+

126+noMagicDo :: Parser Bool

127+noMagicDo = switch $

128+ long "no-magic-do"

129+ <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."

130+

131+noTco :: Parser Bool

132+noTco = switch $

133+ long "no-tco"

134+ <> help "Disable tail call optimizations"

135+

136+noPrelude :: Parser Bool

137+noPrelude = switch $

138+ long "no-prelude"

139+ <> help "Omit the Prelude"

140+

141+useStdIn :: Parser Bool

142+useStdIn = switch $

143+ short 's'

144+ <> long "stdin"

145+ <> help "Read from standard input"

146+

147+inputFile :: Parser FilePath

148+inputFile = strArgument $

149+ metavar "FILE"

150+ <> help "The input .ps file(s)"

151+

152+outputFile :: Parser (Maybe FilePath)

153+outputFile = optional . strOption $

154+ short 'o'

155+ <> long "output"

156+ <> help "The output .js file"

157+

158+externsFile :: Parser (Maybe FilePath)

159+externsFile = optional . strOption $

160+ short 'e'

161+ <> long "externs"

162+ <> help "The output .e.ps file"

163+

164+noPrefix :: Parser Bool

165+noPrefix = switch $

166+ short 'p'

167+ <> long "no-prefix"

168+ <> help "Do not include comment header"

169+

170+options :: Parser (P.Options P.Compile)

171+options = P.Options <$> noPrelude

172+ <*> noTco

173+ <*> noMagicDo

174+ <*> runMain

175+ <*> noOpts

176+ <*> verboseErrors

177+ <*> additionalOptions

178+ where

179+ additionalOptions =

134− additionalOptions = P.CompileOptions <$> browserNamespace <*> dceModules <*> codeGenModules

180+ P.CompileOptions <$> browserNamespace

135−

181+ <*> many dceModule

136−term :: Term (IO ())

182+ <*> many codeGenModule

137−term = compile <$> options <*> useStdIn <*> inputFiles <*> outputFile <*> externsFile <*> (not <$> noPrefix)

183+

138−

184+pscOptions :: Parser PSCOptions

139−termInfo :: TermInfo

185+pscOptions = PSCOptions <$> many inputFile

140−termInfo = defTI

186+ <*> options

141− { termName = "psc"

187+ <*> useStdIn

142− , version = showVersion Paths.version

188+ <*> outputFile

143− , termDoc = "Compiles PureScript to Javascript"

189+ <*> externsFile

144− }

190+ <*> (not <$> noPrefix)

145

191

146main :: IO ()

192main :: IO ()

147−main = run (term, termInfo)

193+main = execParser opts >>= compile

148−

194+ where

195+ opts = info (helper <*> pscOptions) infoModList

196+ infoModList = fullDesc <> headerInfo <> footerInfo

197+ headerInfo = header "psc - Compiles PureScript to Javascript"

198+ footerInfo = footer $ "psc " ++ showVersion Paths.version

149

199

psci/Main.hs+43−37

@@ -33,25 +33,32 @@ import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

33import Control.Monad.Trans.State.Strict

34import qualified Control.Monad.Trans.State.Lazy as L

36+import Options.Applicative as Opts

37+

36import System.Console.Haskeline

38import System.Console.Haskeline

37import System.Directory (createDirectoryIfMissing, getModificationTime, doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)

39import System.Directory (createDirectoryIfMissing, getModificationTime, doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)

38import System.Exit

40import System.Exit

39import System.FilePath (pathSeparator, takeDirectory, (</>), isPathSeparator)

41import System.FilePath (pathSeparator, takeDirectory, (</>), isPathSeparator)

40import System.IO.Error (tryIOError)

42import System.IO.Error (tryIOError)

41import System.Process (readProcessWithExitCode)

43import System.Process (readProcessWithExitCode)

42−import qualified System.Console.CmdTheLine as Cmd

43import qualified System.IO.UTF8 as U (writeFile, putStrLn, print, readFile)

44import qualified System.IO.UTF8 as U (writeFile, putStrLn, print, readFile)

45−import Text.Parsec (ParseError)

46+import qualified Text.Parsec as Par (ParseError)

47import qualified Language.PureScript as P

48import qualified Language.PureScript as P

48import qualified Language.PureScript.AST as D

49import qualified Language.PureScript.AST as D

49import qualified Language.PureScript.Names as N

50import qualified Language.PureScript.Names as N

50import qualified Paths_purescript as Paths

51import qualified Paths_purescript as Paths

52−import Commands

53+import Commands as C

53import Parser

54import Parser

56+

57+data PSCiOptions = PSCiOptions

58+ { psciSingleLineFlag :: Bool

59+ , psciInputFile :: [FilePath]

60+ }

61+

55-- |

62-- |

56-- The PSCI state.

63-- The PSCI state.

57-- Holds a list of imported modules, loaded files, and partial let bindings.

64-- Holds a list of imported modules, loaded files, and partial let bindings.

@@ -125,7 +132,7 @@ loadModule filename = either (Left . show) Right . P.runIndentParser filename P.

125-- |

132-- |

126-- Load all modules, including the Prelude

133-- Load all modules, including the Prelude

127--

134--

128−loadAllModules :: [FilePath] -> IO (Either ParseError [(Either P.RebuildPolicy FilePath, P.Module)])

135+loadAllModules :: [FilePath] -> IO (Either Par.ParseError [(Either P.RebuildPolicy FilePath, P.Module)])

129loadAllModules files = do

136loadAllModules files = do

130 filesAndContent <- forM files $ \filename -> do

137 filesAndContent <- forM files $ \filename -> do

131 content <- U.readFile filename

138 content <- U.readFile filename

@@ -146,7 +153,7 @@ expandTilde p = return p

146--

153--

147helpMessage :: String

154helpMessage :: String

148helpMessage = "The following commands are available:\n\n " ++

155helpMessage = "The following commands are available:\n\n " ++

149− intercalate "\n " (map (intercalate " ") help)

156+ intercalate "\n " (map (intercalate " ") C.help)

150

157

151-- |

158-- |

152-- The welcome prologue.

159-- The welcome prologue.

@@ -180,10 +187,10 @@ completion :: CompletionFunc (StateT PSCiState IO)

180completion = completeWord Nothing " \t\n\r" findCompletions

187completion = completeWord Nothing " \t\n\r" findCompletions

181 where

188 where

182 findCompletions :: String -> StateT PSCiState IO [Completion]

189 findCompletions :: String -> StateT PSCiState IO [Completion]

183− findCompletions str = do

190+ findCompletions st = do

184 ms <- map snd . psciLoadedModules <$> get

191 ms <- map snd . psciLoadedModules <$> get

185− files <- listFiles str

192+ files <- listFiles st

186− let matches = filter (isPrefixOf str) (names ms)

193+ let matches = filter (isPrefixOf st) (names ms)

187 return $ sortBy sorter $ map simpleCompletion matches ++ files

194 return $ sortBy sorter $ map simpleCompletion matches ++ files

188 getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident

195 getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident

189 getDeclName Nothing (P.ValueDeclaration ident _ _ _) = Just ident

196 getDeclName Nothing (P.ValueDeclaration ident _ _ _) = Just ident

@@ -248,13 +255,13 @@ mkdirp = createDirectoryIfMissing True . takeDirectory

248-- Makes a volatile module to execute the current expression.

255-- Makes a volatile module to execute the current expression.

249--

256--

250createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module

257createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module

251−createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetBindings = lets} value =

258+createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetBindings = lets} val =

252 let

259 let

253 moduleName = P.ModuleName [P.ProperName "$PSCI"]

260 moduleName = P.ModuleName [P.ProperName "$PSCI"]

254 importDecl m = P.ImportDeclaration m P.Unqualified Nothing

261 importDecl m = P.ImportDeclaration m P.Unqualified Nothing

255 traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]

262 traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]

256 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))

263 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))

257− itValue = foldl (\x f -> f x) value lets

264+ itValue = foldl (\x f -> f x) val lets

258 mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

265 mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

259 itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] $ Right itValue

266 itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] $ Right itValue

260 mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue

267 mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue

@@ -295,9 +302,9 @@ indexFile = ".psci_modules" ++ pathSeparator : "index.js"

295-- Takes a value declaration and evaluates it with the current state.

302-- Takes a value declaration and evaluates it with the current state.

296--

303--

297handleDeclaration :: P.Expr -> PSCI ()

304handleDeclaration :: P.Expr -> PSCI ()

298−handleDeclaration value = do

305+handleDeclaration val = do

299 st <- PSCI $ lift get

306 st <- PSCI $ lift get

300− let m = createTemporaryModule True st value

307+ let m = createTemporaryModule True st val

301 e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

308 e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

302 case e of

309 case e of

303 Left err -> PSCI $ outputStrLn err

310 Left err -> PSCI $ outputStrLn err

@@ -363,9 +370,9 @@ handleImport moduleName = do

363-- Takes a value and prints its type

370-- Takes a value and prints its type

364--

371--

365handleTypeOf :: P.Expr -> PSCI ()

372handleTypeOf :: P.Expr -> PSCI ()

366−handleTypeOf value = do

373+handleTypeOf val = do

367 st <- PSCI $ lift get

374 st <- PSCI $ lift get

368− let m = createTemporaryModule False st value

375+ let m = createTemporaryModule False st val

369 e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

376 e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

370 case e of

377 case e of

371 Left err -> PSCI $ outputStrLn err

378 Left err -> PSCI $ outputStrLn err

@@ -434,7 +441,7 @@ handleKindOf typ = do

434-- |

441-- |

435-- Parses the input and returns either a Metacommand or an expression.

442-- Parses the input and returns either a Metacommand or an expression.

436--

443--

437−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either ParseError (Maybe Command))

444+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either Par.ParseError (Maybe Command))

438getCommand singleLineMode = do

445getCommand singleLineMode = do

439 firstLine <- getInputLine "> "

446 firstLine <- getInputLine "> "

440 case firstLine of

447 case firstLine of

@@ -478,17 +485,6 @@ handleCommand (Show "loaded") = handleShowLoadedModules

478handleCommand (Show "import") = handleShowImportedModules

485handleCommand (Show "import") = handleShowImportedModules

479handleCommand _ = PSCI $ outputStrLn "Unknown command"

486handleCommand _ = PSCI $ outputStrLn "Unknown command"

480

487

481−singleLineFlag :: Cmd.Term Bool

482−singleLineFlag = Cmd.value $ Cmd.flag $ (Cmd.optInfo ["single-line-mode"])

483− { Cmd.optName = "Single-line mode"

484− , Cmd.optDoc = "Run in single-line mode"

485− }

486−

487−inputFiles :: Cmd.Term [FilePath]

488−inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posName = "file(s)"

489− , Cmd.posDoc = "Optional .purs files to load on start"

490− }

491−

492loadUserConfig :: IO (Maybe [Command])

488loadUserConfig :: IO (Maybe [Command])

493loadUserConfig = do

489loadUserConfig = do

494 configFile <- (</> ".psci") <$> getCurrentDirectory

490 configFile <- (</> ".psci") <$> getCurrentDirectory

@@ -505,8 +501,8 @@ loadUserConfig = do

505-- |

501-- |

506-- The PSCI main loop.

502-- The PSCI main loop.

507--

503--

508−loop :: Bool -> [FilePath] -> IO ()

504+loop :: PSCiOptions -> IO ()

509−loop singleLineMode files = do

505+loop (PSCiOptions singleLineMode files) = do

510 config <- loadUserConfig

506 config <- loadUserConfig

511 modulesOrFirstError <- loadAllModules files

507 modulesOrFirstError <- loadAllModules files

512 case modulesOrFirstError of

508 case modulesOrFirstError of

@@ -528,15 +524,25 @@ loop singleLineMode files = do

528 Right (Just Quit) -> outputStrLn quitMessage

524 Right (Just Quit) -> outputStrLn quitMessage

529 Right (Just c') -> runPSCI (handleCommand c') >> go

525 Right (Just c') -> runPSCI (handleCommand c') >> go

530

526

531−term :: Cmd.Term (IO ())

527+singleLineFlag :: Parser Bool

532−term = loop <$> singleLineFlag <*> inputFiles

528+singleLineFlag = switch $

529+ long "single-line-mode"

530+ <> Opts.help "Run in single-line mode"

533

531

534−termInfo :: Cmd.TermInfo

532+inputFile :: Parser FilePath

535−termInfo = Cmd.defTI

533+inputFile = strArgument $

536− { Cmd.termName = "psci"

534+ metavar "FILE"

537− , Cmd.version = showVersion Paths.version

535+ <> Opts.help "Optional .purs files to load on start"

538− , Cmd.termDoc = "Interactive mode for PureScript"

536+

539− }

537+psciOptions :: Parser PSCiOptions

538+psciOptions = PSCiOptions <$> singleLineFlag

539+ <*> many inputFile

540

541main :: IO ()

542−main = Cmd.run (term, termInfo)

542+main = execParser opts >>= loop

543+ where

544+ opts = info (helper <*> psciOptions) infoModList

545+ infoModList = fullDesc <> headerInfo <> footerInfo

546+ headerInfo = header "psci - Interactive mode for PureScript"

547+ footerInfo = footer $ "psci " ++ showVersion Paths.version

548+

purescript.cabal+13−13

@@ -25,7 +25,6 @@ source-repository head

26library

27 build-depends: base >=4.6 && <5,

28− cmdtheline == 0.2.*,

29 containers -any,

28 containers -any,

30 unordered-containers -any,

29 unordered-containers -any,

31 directory >= 1.2,

30 directory >= 1.2,

@@ -107,9 +106,9 @@ library

107 ghc-options: -Wall -O2

106 ghc-options: -Wall -O2

108

107

109executable psc

108executable psc

110− build-depends: base >=4 && <5, cmdtheline -any, containers -any,

109+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

111− directory -any, filepath -any, mtl -any, parsec -any,

110+ mtl -any, optparse-applicative -any, parsec -any, purescript -any,

112− purescript -any, transformers -any, utf8-string -any

111+ transformers -any, utf8-string -any

113 main-is: Main.hs

112 main-is: Main.hs

114 buildable: True

113 buildable: True

115 hs-source-dirs: psc

114 hs-source-dirs: psc

@@ -117,9 +116,9 @@ executable psc

117 ghc-options: -Wall -O2 -fno-warn-unused-do-bind

116 ghc-options: -Wall -O2 -fno-warn-unused-do-bind

118

117

119executable psc-make

118executable psc-make

120− build-depends: base >=4 && <5, cmdtheline -any, containers -any,

119+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

121− directory -any, filepath -any, mtl -any, parsec -any,

120+ mtl -any, optparse-applicative -any, parsec -any, purescript -any,

122− purescript -any, transformers -any, utf8-string -any

121+ transformers -any, utf8-string -any

123 main-is: Main.hs

122 main-is: Main.hs

124 buildable: True

123 buildable: True

125 hs-source-dirs: psc-make

124 hs-source-dirs: psc-make

@@ -128,9 +127,10 @@ executable psc-make

128

127

129executable psci

128executable psci

130 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

129 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

130+ mtl -any, optparse-applicative -any, parsec -any,

131− mtl -any, parsec -any, haskeline >= 0.7.0.0, purescript -any,

131+ haskeline >= 0.7.0.0, purescript -any, transformers -any,

132− transformers -any, utf8-string -any, process -any,

132+ utf8-string -any, process -any

133− cmdtheline -any

133+

134 main-is: Main.hs

135 buildable: True

136 hs-source-dirs: psci

@@ -139,8 +139,8 @@ executable psci

139 ghc-options: -Wall -O2

140

141executable psc-docs

142− build-depends: base >=4 && <5, cmdtheline -any, purescript -any, utf8-string -any,

142+ build-depends: base >=4 && <5, purescript -any, utf8-string -any,

143− process -any, mtl -any

143+ optparse-applicative -any, process -any, mtl -any

144 main-is: Main.hs

145 buildable: True

146 hs-source-dirs: psc-docs

@@ -148,7 +148,7 @@ executable psc-docs

148 ghc-options: -Wall -O2

149

150executable hierarchy

151− build-depends: base >=4 && <5, cmdtheline -any, purescript -any, utf8-string -any,

151+ build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative -any,

152 process -any, mtl -any, parsec -any, filepath -any, directory -any

153 main-is: Main.hs

154 buildable: True