git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Refactor parseAndDesugar
4c1d5afHarry Garrood
psc-docs/Main.hs+3−2
compare with golang
unifiedsplit
@@ -16,6 +16,7 @@
16module Main where
16module Main where
17
17
18import Control.Applicative
18import Control.Applicative
19+import Control.Monad.Trans.Except (runExceptT)
19import Control.Arrow (first, second)
20import Control.Arrow (first, second)
20import Control.Category ((>>>))
21import Control.Category ((>>>))
21import Control.Monad.Writer
22import Control.Monad.Writer
@@ -68,12 +69,12 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
68 Etags -> dumpTags input dumpEtags
69 Etags -> dumpTags input dumpEtags
69 Ctags -> dumpTags input dumpCtags
70 Ctags -> dumpTags input dumpCtags
70 Markdown -> do
71 Markdown -> do
71− e <- D.parseAndDesugar input [] (\_ ms -> return ms)
72+ e <- liftIO . runExceptT $ D.parseAndDesugar input []
72 case e of
73 case e of
73 Left err -> do
74 Left err -> do
74 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
75 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
75 exitFailure
76 exitFailure
76− Right ms' ->
77+ Right (ms', _) ->
77 case output of
78 case output of
78 EverythingToStdOut ->
79 EverythingToStdOut ->
79 putStrLn (D.renderModulesAsMarkdown ms')
80 putStrLn (D.renderModulesAsMarkdown ms')
purescript.cabal+2−1
@@ -220,7 +220,8 @@ executable psc-docs
220 build-depends: base >=4 && <5, purescript -any,
220 build-depends: base >=4 && <5, purescript -any,
221 optparse-applicative >= 0.10.0, process -any, mtl -any,
221 optparse-applicative >= 0.10.0, process -any, mtl -any,
222 split -any, ansi-wl-pprint -any, directory -any,
222 split -any, ansi-wl-pprint -any, directory -any,
223− filepath -any, Glob -any
223+ filepath -any, Glob -any, transformers -any,
224+ transformers-compat -any
224 main-is: Main.hs
225 main-is: Main.hs
225 buildable: True
226 buildable: True
226 hs-source-dirs: psc-docs
227 hs-source-dirs: psc-docs
src/Language/PureScript/Docs/ParseAndDesugar.hs+28−21
@@ -1,4 +1,5 @@
1{-# LANGUAGE TupleSections #-}
1{-# LANGUAGE TupleSections #-}
2+{-# LANGUAGE FlexibleContexts #-}
2
3
3module Language.PureScript.Docs.ParseAndDesugar
4module Language.PureScript.Docs.ParseAndDesugar
4 ( parseAndDesugar
5 ( parseAndDesugar
@@ -11,7 +12,6 @@ import qualified Data.Map as M
11import Control.Arrow (first)
12import Control.Arrow (first)
12import Control.Monad
13import Control.Monad
13
14
14−import Control.Monad.Trans.Except
15import Control.Monad.Writer.Strict (runWriterT)
15import Control.Monad.Writer.Strict (runWriterT)
16import Control.Monad.Error.Class (MonadError(..))
16import Control.Monad.Error.Class (MonadError(..))
17import Control.Monad.IO.Class (MonadIO(..))
17import Control.Monad.IO.Class (MonadIO(..))
@@ -29,40 +29,40 @@ import Language.PureScript.Docs.Convert (collectBookmarks)
29-- * A list of local source files
29-- * A list of local source files
30-- * A list of source files from external dependencies, together with their
30-- * A list of source files from external dependencies, together with their
31-- package names
31-- package names
32−-- * A callback, taking a list of bookmarks, and a list of desugared modules
33--
32--
34-- This function does the following:
33-- This function does the following:
35--
34--
36-- * Parse all of the input and dependency source files
35-- * Parse all of the input and dependency source files
37−-- * Partially desugar all of the resulting modules
36+-- * Partially desugar all of the resulting modules (just enough for
37+-- producing documentation from them)
38-- * Collect a list of bookmarks from the whole set of source files
38-- * Collect a list of bookmarks from the whole set of source files
39-- * Collect a list of desugared modules from just the input source files (not
39-- * Collect a list of desugared modules from just the input source files (not
40-- dependencies)
40-- dependencies)
41−-- * Call the callback with the bookmarks and desugared module list.
41+-- * Return the desugared modules and the bookmarks.
42parseAndDesugar ::
42parseAndDesugar ::
43+ (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadIO m) =>
43 [FilePath]
44 [FilePath]
44 -> [(PackageName, FilePath)]
45 -> [(PackageName, FilePath)]
45− -> ([Bookmark] -> [P.Module] -> IO a)
46+ -> m ([P.Module], [Bookmark])
46− -> IO (Either P.MultipleErrors a)
47−parseAndDesugar inputFiles depsFiles callback = do
47+parseAndDesugar inputFiles depsFiles = do
48 inputFiles' <- traverse (parseAs Local) inputFiles
48 inputFiles' <- traverse (parseAs Local) inputFiles
49 depsFiles' <- traverse (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
49 depsFiles' <- traverse (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
50
50
51− runExceptT $ do
52− ms <- parseFiles (inputFiles' ++ depsFiles')
51+ ms <- parseFiles (inputFiles' ++ depsFiles')
53− ms' <- sortModules (map snd ms)
52+ ms' <- sortModules (map snd ms)
54− (bs, ms'') <- desugarWithBookmarks ms ms'
53+ desugarWithBookmarks ms ms'
55− liftIO $ callback bs ms''
56
54
57parseFiles ::
55parseFiles ::
56+ (MonadError P.MultipleErrors m, MonadIO m) =>
58 [(FileInfo, FilePath)]
57 [(FileInfo, FilePath)]
59− -> ExceptT P.MultipleErrors IO [(FileInfo, P.Module)]
58+ -> m [(FileInfo, P.Module)]
60parseFiles =
59parseFiles =
61 throwLeft . P.parseModulesFromFiles fileInfoToString
60 throwLeft . P.parseModulesFromFiles fileInfoToString
62
61
63sortModules ::
62sortModules ::
63+ (Functor m, MonadError P.MultipleErrors m, MonadIO m) =>
64 [P.Module]
64 [P.Module]
65− -> ExceptT P.MultipleErrors IO [P.Module]
65+ -> m [P.Module]
66sortModules =
66sortModules =
67 fmap fst . throwLeft . sortModules' . map importPrim
67 fmap fst . throwLeft . sortModules' . map importPrim
68 where
68 where
@@ -70,9 +70,10 @@ sortModules =
70 sortModules' = P.sortModules
70 sortModules' = P.sortModules
71
71
72desugarWithBookmarks ::
72desugarWithBookmarks ::
73+ (MonadError P.MultipleErrors m, MonadIO m) =>
73 [(FileInfo, P.Module)]
74 [(FileInfo, P.Module)]
74 -> [P.Module]
75 -> [P.Module]
75− -> ExceptT P.MultipleErrors IO ([Bookmark], [P.Module])
76+ -> m ([P.Module], [Bookmark])
76desugarWithBookmarks msInfo msSorted = do
77desugarWithBookmarks msInfo msSorted = do
77 msDesugared <- throwLeft (desugar msSorted)
78 msDesugared <- throwLeft (desugar msSorted)
78
79
@@ -80,7 +81,7 @@ desugarWithBookmarks msInfo msSorted = do
80 msPackages = map (addPackage msDeps) msDesugared
81 msPackages = map (addPackage msDeps) msDesugared
81 bookmarks = concatMap collectBookmarks msPackages
82 bookmarks = concatMap collectBookmarks msPackages
82
83
83− return (bookmarks, takeLocals msPackages)
84+ return (takeLocals msPackages, bookmarks)
84
85
85throwLeft :: (MonadError l m) => Either l r -> m r
86throwLeft :: (MonadError l m) => Either l r -> m r
86throwLeft = either throwError return
87throwLeft = either throwError return
@@ -101,18 +102,24 @@ fileInfoToString (FromDep _ fn) = fn
101importPrim :: P.Module -> P.Module
102importPrim :: P.Module -> P.Module
102importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])
103importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])
103
104
104−desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]
105+desugar ::
106+ (Functor m, Applicative m, MonadError P.MultipleErrors m) =>
107+ [P.Module]
108+ -> m [P.Module]
105desugar = P.evalSupplyT 0 . desugar'
109desugar = P.evalSupplyT 0 . desugar'
106 where
110 where
107− desugar' :: [P.Module] -> P.SupplyT (Either P.MultipleErrors) [P.Module]
111+ desugar' =
112+ traverse P.desugarDoModule
113+ >=> P.desugarCasesModule
108− desugar' = traverse P.desugarDoModule >=> P.desugarCasesModule >=> ignoreWarnings . P.desugarImports []
114+ >=> ignoreWarnings . P.desugarImports []
115+
109 ignoreWarnings m = liftM fst (runWriterT m)
116 ignoreWarnings m = liftM fst (runWriterT m)
110
117
111parseFile :: FilePath -> IO (FilePath, String)
118parseFile :: FilePath -> IO (FilePath, String)
112parseFile input' = (,) input' <$> readFile input'
119parseFile input' = (,) input' <$> readFile input'
113
120
114−parseAs :: (FilePath -> a) -> FilePath -> IO (a, String)
121+parseAs :: (Functor m, MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)
115−parseAs g = fmap (first g) . parseFile
122+parseAs g = fmap (first g) . liftIO . parseFile
116
123
117getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName
124getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName
118getDepsModuleNames = foldl go M.empty
125getDepsModuleNames = foldl go M.empty
src/Language/PureScript/Publish.hs+11−4
@@ -146,11 +146,18 @@ preparePackage' opts = do
146getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.Module])
146getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.Module])
147getModulesAndBookmarks = do
147getModulesAndBookmarks = do
148 (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles
148 (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles
149− liftIO (D.parseAndDesugar inputFiles depsFiles renderModules)
149+ (modules', bookmarks) <- parseAndDesugar inputFiles depsFiles
150− >>= either (userError . CompileError) return
150+
151+ return (bookmarks, map D.convertModule modules')
152+
151 where
153 where
152− renderModules bookmarks modules =
154+ parseAndDesugar inputFiles depsFiles = do
153− return (bookmarks, map D.convertModule modules)
155+ r <- liftIO . runExceptT $ D.parseAndDesugar inputFiles depsFiles
156+ case r of
157+ Right r' ->
158+ return r'
159+ Left err ->
160+ userError (CompileError err)
154
161
155data TreeStatus = Clean | Dirty deriving (Show, Read, Eq, Ord, Enum)
162data TreeStatus = Clean | Dirty deriving (Show, Read, Eq, Ord, Enum)
156
163