Skip to content

Commit a64cb50

Browse files
berewtberewt
committed
Add a --comments option
1 parent aae1a07 commit a64cb50

File tree

14 files changed

+199
-131
lines changed

14 files changed

+199
-131
lines changed

‎psc-make/Main.hs‎

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,10 @@ module Main where
1818

1919
import Control.Applicative
2020
import Control.Monad.Error
21+
import Control.Monad.Reader
2122

2223
import Data.Version (showVersion)
24+
import Data.Traversable (traverse)
2325

2426
import Options.Applicative as Opts
2527

@@ -50,28 +52,26 @@ readInput InputOptions{..} = do
5052
content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile
5153
return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)
5254

53-
newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)
55+
newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ErrorT String IO) a }
56+
deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadReader (P.Options P.Make))
5457

55-
runMake :: Make a -> IO (Either String a)
56-
runMake = runErrorT . unMake
58+
runMake :: P.Options P.Make -> Make a -> IO (Either String a)
59+
runMake opts = runErrorT . flip runReaderT opts . unMake
5760

5861
makeIO :: IO a -> Make a
59-
makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
62+
makeIO = Make . lift . ErrorT . fmap (either (Left . show) Right) . tryIOError
6063

6164
instance P.MonadMake Make where
6265
getTimestamp path = makeIO $ do
6366
exists <- doesFileExist path
64-
case exists of
65-
True -> Just <$> getModificationTime path
66-
False -> return Nothing
67+
traverse (const $ getModificationTime path) $ guard exists
6768
readTextFile path = makeIO $ do
6869
putStrLn $ "Reading " ++ path
6970
readFile path
7071
writeTextFile path text = makeIO $ do
7172
mkdirp path
7273
putStrLn $ "Writing " ++ path
7374
writeFile path text
74-
liftError = either throwError return
7575
progress = makeIO . putStrLn
7676

7777
compile :: PSCMakeOptions -> IO ()
@@ -82,7 +82,7 @@ compile (PSCMakeOptions input outputDir opts usePrefix) = do
8282
print err
8383
exitFailure
8484
Right ms -> do
85-
e <- runMake $ P.make outputDir opts ms prefix
85+
e <- runMake opts $ P.make outputDir ms prefix
8686
case e of
8787
Left err -> do
8888
putStrLn err
@@ -130,6 +130,12 @@ noOpts = switch $
130130
long "no-opts"
131131
<> help "Skip the optimization phase."
132132

133+
comments :: Parser Bool
134+
comments = switch $
135+
short 'c'
136+
<> long "comments"
137+
<> help "Include comments in the generated code."
138+
133139
verboseErrors :: Parser Bool
134140
verboseErrors = switch $
135141
short 'v'
@@ -149,6 +155,7 @@ options = P.Options <$> noPrelude
149155
<*> noMagicDo
150156
<*> pure Nothing
151157
<*> noOpts
158+
<*> comments
152159
<*> verboseErrors
153160
<*> pure P.MakeOptions
154161

‎psc/Main.hs‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Main where
1818

1919
import Control.Applicative
2020
import Control.Monad.Error
21+
import Control.Monad.Reader
2122

2223
import Data.Maybe (fromMaybe)
2324
import Data.Version (showVersion)
@@ -61,7 +62,7 @@ compile (PSCOptions input opts stdin output externs usePrefix) = do
6162
hPutStrLn stderr $ show err
6263
exitFailure
6364
Right ms -> do
64-
case P.compile opts (map snd ms) prefix of
65+
case P.compile (map snd ms) prefix `runReaderT` opts of
6566
Left err -> do
6667
hPutStrLn stderr err
6768
exitFailure
@@ -137,6 +138,12 @@ noPrelude = switch $
137138
long "no-prelude"
138139
<> help "Omit the Prelude"
139140

141+
comments :: Parser Bool
142+
comments = switch $
143+
short 'c'
144+
<> long "comments"
145+
<> help "Include comments in the generated code."
146+
140147
useStdIn :: Parser Bool
141148
useStdIn = switch $
142149
short 's'
@@ -173,6 +180,7 @@ options = P.Options <$> noPrelude
173180
<*> runMain
174181
<*> noOpts
175182
<*> verboseErrors
183+
<*> comments
176184
<*> additionalOptions
177185
where
178186
additionalOptions =

‎psci/Main.hs‎

Lines changed: 16 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ import qualified Data.Map as M
2828
import Control.Applicative
2929
import Control.Monad
3030
import Control.Monad.Error (ErrorT(..), MonadError)
31-
import Control.Monad.Error.Class (MonadError(..))
31+
import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
3232
import Control.Monad.Trans.Class
3333
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
3434
import Control.Monad.Trans.State.Strict
@@ -150,7 +150,7 @@ loadAllImportedModules = do
150150
modulesOrFirstError <- psciIO $ loadAllModules files
151151
case modulesOrFirstError of
152152
Left err -> psciIO $ print err
153-
Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
153+
Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
154154

155155
-- |
156156
-- Expands tilde in path.
@@ -314,35 +314,33 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
314314
-- | Compilation options.
315315
--
316316
options :: P.Options P.Make
317-
options = P.Options False False False Nothing False False P.MakeOptions
317+
options = P.Options False False False Nothing False False False P.MakeOptions
318318

319319
-- |
320320
-- PSCI monad
321321
--
322322
newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
323323

324324
psciIO :: IO a -> PSCI a
325-
psciIO io = PSCI (lift (lift io))
325+
psciIO io = PSCI . lift $ lift io
326326

327-
newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadError String)
327+
newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ErrorT String IO) a }
328+
deriving (Functor, Applicative, Monad, MonadError String, MonadReader (P.Options P.Make))
328329

329330
runMake :: Make a -> IO (Either String a)
330-
runMake = runErrorT . unMake
331+
runMake = runErrorT . flip runReaderT options . unMake
331332

332333
makeIO :: IO a -> Make a
333-
makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
334+
makeIO = Make . lift . ErrorT . fmap (either (Left . show) Right) . tryIOError
334335

335336
instance P.MonadMake Make where
336337
getTimestamp path = makeIO $ do
337338
exists <- doesFileExist path
338-
if exists
339-
then Just <$> getModificationTime path
340-
else return Nothing
339+
traverse (const $ getModificationTime path) $ guard exists
341340
readTextFile path = makeIO $ readFile path
342341
writeTextFile path text = makeIO $ do
343342
mkdirp path
344343
writeFile path text
345-
liftError = either throwError return
346344
progress s = unless (s == "Compiling $PSCI") $ makeIO . putStrLn $ s
347345

348346
mkdirp :: FilePath -> IO ()
@@ -402,7 +400,7 @@ handleDeclaration :: P.Expr -> PSCI ()
402400
handleDeclaration val = do
403401
st <- PSCI $ lift get
404402
let m = createTemporaryModule True st val
405-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
403+
e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
406404
case e of
407405
Left err -> PSCI $ outputStrLn err
408406
Right _ -> do
@@ -423,7 +421,7 @@ handleLet ds = do
423421
st <- PSCI $ lift get
424422
let st' = updateLets ds st
425423
let m = createTemporaryModule False st' (P.ObjectLiteral [])
426-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []
424+
e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []
427425
case e of
428426
Left err -> PSCI $ outputStrLn err
429427
Right _ -> PSCI $ lift (put st')
@@ -456,7 +454,7 @@ handleImport :: P.ModuleName -> PSCI ()
456454
handleImport moduleName = do
457455
st <- updateImports moduleName <$> PSCI (lift get)
458456
let m = createTemporaryModuleForImports st
459-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
457+
e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
460458
case e of
461459
Left err -> PSCI $ outputStrLn err
462460
Right _ -> do
@@ -470,7 +468,7 @@ handleTypeOf :: P.Expr -> PSCI ()
470468
handleTypeOf val = do
471469
st <- PSCI $ lift get
472470
let m = createTemporaryModule False st val
473-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
471+
e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
474472
case e of
475473
Left err -> PSCI $ outputStrLn err
476474
Right env' ->
@@ -504,7 +502,7 @@ handleBrowse :: P.ModuleName -> PSCI ()
504502
handleBrowse moduleName = do
505503
st <- PSCI $ lift get
506504
let loadedModules = psciLoadedModules st
507-
env <- psciIO . runMake $ P.make modulesDir options loadedModules []
505+
env <- psciIO . runMake $ P.make modulesDir loadedModules []
508506
case env of
509507
Left err -> PSCI $ outputStrLn err
510508
Right env' ->
@@ -520,7 +518,7 @@ handleKindOf typ = do
520518
st <- PSCI $ lift get
521519
let m = createTemporaryModuleForKind st typ
522520
mName = P.ModuleName [P.ProperName "$PSCI"]
523-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
521+
e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
524522
case e of
525523
Left err -> PSCI $ outputStrLn err
526524
Right env' ->
@@ -571,7 +569,7 @@ handleCommand (LoadFile filePath) = do
571569
PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
572570
handleCommand Reset = do
573571
files <- psciImportedFilenames <$> PSCI (lift get)
574-
PSCI . lift . modify $ \st -> st
572+
PSCI . lift . modify $ \st -> st
575573
{ psciImportedFilenames = files
576574
, psciImportedModuleNames = defaultImports
577575
, psciLetBindings = []

0 commit comments

Comments
 (0)