git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #736 from anthoq88/master
fc6e344Phil Freeman
hierarchy/Main.hs+32−22
@@ -15,25 +15,30 @@
15
15
16module Main where
16module Main where
17
17
18−import Control.Applicative ((<*>), (<$>))
19import Control.Monad (unless)
18import Control.Monad (unless)
20
19
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)
24
23
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)
30
29
31−import Text.Parsec (ParseError)
30+import Text.Parsec as Par (ParseError)
32
31
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
35
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
39
44
@@ -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)
51
56
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
56
61
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 _ = []
84
89
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"
88
96
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"
92
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
22import Data.List
23import Data.Maybe (fromMaybe)
23import Data.Maybe (fromMaybe)
24import Data.Version (showVersion)
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)
31
33
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
21
21
22import Data.Version (showVersion)
22import Data.Version (showVersion)
23
23
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
34
35
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
39
48
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)
44
53
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
68
77
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
91
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)
22import Data.Maybe (fromMaybe)
23import Data.Version (showVersion)
23import Data.Version (showVersion)
24
24
25−import System.Console.CmdTheLine
25+import Options.Applicative as Opts
26import System.Directory (createDirectoryIfMissing)
26import System.Directory (createDirectoryIfMissing)
27import System.FilePath (takeDirectory)
27import System.FilePath (takeDirectory)
28import System.Exit (exitSuccess, exitFailure)
28import System.Exit (exitSuccess, exitFailure)
@@ -32,6 +32,16 @@ import qualified Language.PureScript as P
32import qualified Paths_purescript as Paths
32import qualified Paths_purescript as Paths
33import qualified System.IO.UTF8 as U
33import qualified System.IO.UTF8 as U
34
34
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)
46
56
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
74
84
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
33import Control.Monad.Trans.State.Strict
34import qualified Control.Monad.Trans.State.Lazy as L
34import qualified Control.Monad.Trans.State.Lazy as L
35
35
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)
44
45
45−import Text.Parsec (ParseError)
46+import qualified Text.Parsec as Par (ParseError)
46
47
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
51
52
52−import Commands
53+import Commands as C
53import Parser
54import Parser
54
55
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
540
541main :: IO ()
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
25
25
26library
26library
27 build-depends: base >=4.6 && <5,
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
134 main-is: Main.hs
135 buildable: True
135 buildable: True
136 hs-source-dirs: psci
136 hs-source-dirs: psci
@@ -139,8 +139,8 @@ executable psci
139 ghc-options: -Wall -O2
139 ghc-options: -Wall -O2
140
140
141executable psc-docs
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
144 main-is: Main.hs
145 buildable: True
145 buildable: True
146 hs-source-dirs: psc-docs
146 hs-source-dirs: psc-docs
@@ -148,7 +148,7 @@ executable psc-docs
148 ghc-options: -Wall -O2
148 ghc-options: -Wall -O2
149
149
150executable hierarchy
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
152 process -any, mtl -any, parsec -any, filepath -any, directory -any
153 main-is: Main.hs
153 main-is: Main.hs
154 buildable: True
154 buildable: True