Skip to content

Commit cf65dc8

Browse files
paf31paf31
committed
Tidy up type signatures, use a better type for optional file paths.
1 parent b7dd289 commit cf65dc8

File tree

7 files changed

+56
-39
lines changed

7 files changed

+56
-39
lines changed

‎psc-docs/Main.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ module Main where
1717
import Control.Applicative
1818
import Control.Monad
1919
import Control.Monad.Writer
20+
import Control.Arrow (first)
2021
import Data.Function (on)
2122
import Data.List
2223
import Data.Version (showVersion)
@@ -29,7 +30,7 @@ import System.IO (stderr)
2930

3031
docgen :: Bool -> [FilePath] -> IO ()
3132
docgen showHierarchy input = do
32-
e <- P.parseModulesFromFiles <$> mapM parseFile (nub input)
33+
e <- P.parseModulesFromFiles <$> mapM (fmap (first Just) . parseFile) (nub input)
3334
case e of
3435
Left err -> do
3536
U.hPutStr stderr $ show err

‎psc-make/Main.hs‎

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
--
1313
-----------------------------------------------------------------------------
1414

15-
{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections #-}
15+
{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}
1616

1717
module Main where
1818

@@ -33,10 +33,15 @@ import qualified Language.PureScript as P
3333
import qualified Paths_purescript as Paths
3434
import qualified System.IO.UTF8 as U
3535

36-
readInput :: Bool -> [FilePath] -> IO [(FilePath, String)]
37-
readInput excludePrelude input = do
38-
content <- forM input $ \inputFile -> (inputFile, ) <$> U.readFile inputFile
39-
return $ bool (("<prelude>", P.prelude) :) id excludePrelude content
36+
data InputOptions = InputOptions
37+
{ ioNoPrelude :: Bool
38+
, ioInputFiles :: [FilePath]
39+
}
40+
41+
readInput :: InputOptions -> IO [(Maybe FilePath, String)]
42+
readInput InputOptions{..} = do
43+
content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile
44+
return $ bool ((Nothing, P.prelude) :) id ioNoPrelude content
4045

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

@@ -64,7 +69,7 @@ instance P.MonadMake Make where
6469

6570
compile :: [FilePath] -> FilePath -> P.Options P.Make -> Bool -> IO ()
6671
compile input outputDir opts usePrefix = do
67-
modules <- P.parseModulesFromFiles <$> readInput (P.optionsNoPrelude opts) input
72+
modules <- P.parseModulesFromFiles <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
6873
case modules of
6974
Left err -> do
7075
U.print err

‎psc/Main.hs‎

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
--
1313
-----------------------------------------------------------------------------
1414

15-
{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections #-}
15+
{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}
1616

1717
module Main where
1818

@@ -32,15 +32,21 @@ import qualified Language.PureScript as P
3232
import qualified Paths_purescript as Paths
3333
import qualified System.IO.UTF8 as U
3434

35-
readInput :: Bool -> Bool -> [FilePath] -> IO [(FilePath, String)]
36-
readInput _ True _ = return . ("<stdin>" ,) <$> getContents
37-
readInput excludePrelude _ input = do
38-
content <- forM input $ \inputFile -> (inputFile, ) <$> U.readFile inputFile
39-
return $ bool (("<prelude>", P.prelude) :) id excludePrelude content
35+
data InputOptions = InputOptions
36+
{ ioNoPrelude :: Bool
37+
, ioUseStdIn :: Bool
38+
, ioInputFiles :: [FilePath]
39+
}
40+
41+
readInput :: InputOptions -> IO [(Maybe FilePath, String)]
42+
readInput InputOptions{..}
43+
| ioUseStdIn = return . (Nothing ,) <$> getContents
44+
| otherwise = do content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile
45+
return $ bool ((Nothing, P.prelude) :) id ioNoPrelude content
4046

4147
compile :: P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()
4248
compile opts stdin input output externs usePrefix = do
43-
modules <- P.parseModulesFromFiles <$> readInput (P.optionsNoPrelude opts) stdin input
49+
modules <- P.parseModulesFromFiles <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
4450
case modules of
4551
Left err -> do
4652
U.hPutStr stderr $ show err

‎psci/Main.hs‎

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,7 @@ import qualified Language.PureScript.Declarations as D
6666
data PSCiState = PSCiState
6767
{ psciImportedFilenames :: [FilePath]
6868
, psciImportedModuleNames :: [P.ModuleName]
69-
, psciLoadedModules :: [(FilePath, P.Module)]
69+
, psciLoadedModules :: [(Maybe FilePath, P.Module)]
7070
, psciLetBindings :: [P.Expr -> P.Expr]
7171
}
7272

@@ -87,7 +87,7 @@ updateImports name st = st { psciImportedModuleNames = name : psciImportedModule
8787
-- |
8888
-- Updates the state to have more loaded files.
8989
--
90-
updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState
90+
updateModules :: [(Maybe FilePath, P.Module)] -> PSCiState -> PSCiState
9191
updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
9292

9393
-- |
@@ -130,12 +130,12 @@ loadModule filename = either (Left . show) Right . P.runIndentParser filename P.
130130
-- |
131131
-- Load all modules, including the Prelude
132132
--
133-
loadAllModules :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
133+
loadAllModules :: [FilePath] -> IO (Either ParseError [(Maybe FilePath, P.Module)])
134134
loadAllModules files = do
135135
filesAndContent <- forM files $ \filename -> do
136136
content <- U.readFile filename
137-
return (filename, content)
138-
return $ P.parseModulesFromFiles $ ("<prelude>", P.prelude) : filesAndContent
137+
return (Just filename, content)
138+
return $ P.parseModulesFromFiles $ (Nothing, P.prelude) : filesAndContent
139139

140140

141141
-- |
@@ -303,7 +303,7 @@ handleDeclaration :: P.Expr -> PSCI ()
303303
handleDeclaration value = do
304304
st <- PSCI $ lift get
305305
let m = createTemporaryModule True st value
306-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []
306+
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
307307
case e of
308308
Left err -> PSCI $ outputStrLn err
309309
Right _ -> do
@@ -341,13 +341,13 @@ handleShowImportedModules = do
341341
--
342342
handleImport :: P.ModuleName -> PSCI ()
343343
handleImport moduleName = do
344-
s <- liftM (updateImports moduleName) $ PSCI $ lift get
345-
let m = createTemporaryModuleForImports s
346-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules s ++ [("$PSCI.purs", m)]) []
344+
st <- updateImports moduleName <$> PSCI (lift get)
345+
let m = createTemporaryModuleForImports st
346+
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
347347
case e of
348348
Left err -> PSCI $ outputStrLn err
349349
Right _ -> do
350-
PSCI $ lift $ put s
350+
PSCI $ lift $ put st
351351
return ()
352352

353353
-- |
@@ -357,7 +357,7 @@ handleTypeOf :: P.Expr -> PSCI ()
357357
handleTypeOf value = do
358358
st <- PSCI $ lift get
359359
let m = createTemporaryModule False st value
360-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []
360+
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
361361
case e of
362362
Left err -> PSCI $ outputStrLn err
363363
Right env' ->
@@ -407,7 +407,7 @@ handleKindOf typ = do
407407
st <- PSCI $ lift get
408408
let m = createTemporaryModuleForKind st typ
409409
mName = P.ModuleName [P.ProperName "$PSCI"]
410-
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []
410+
e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [(Nothing, m)]) []
411411
case e of
412412
Left err -> PSCI $ outputStrLn err
413413
Right env' ->
@@ -453,7 +453,7 @@ handleCommand (LoadFile filePath) = do
453453
m <- psciIO $ loadModule absPath
454454
case m of
455455
Left err -> PSCI $ outputStrLn err
456-
Right mods -> PSCI . lift $ modify (updateModules (map ((,) absPath) mods))
456+
Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Just absPath)) mods))
457457
else
458458
PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
459459
handleCommand Reset = do
@@ -504,7 +504,7 @@ loop singleLineMode files = do
504504
Left err -> putStrLn (show err) >> exitFailure
505505
Right modules -> do
506506
historyFilename <- getHistoryFilename
507-
let settings = defaultSettings {historyFile = Just historyFilename}
507+
let settings = defaultSettings { historyFile = Just historyFilename }
508508
flip evalStateT (PSCiState files defaultImports modules []) . runInputT (setComplete completion settings) $ do
509509
outputStrLn prologueMessage
510510
traverse_ (mapM_ (runPSCI . handleCommand)) config

‎src/Language/PureScript.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ import Data.Time.Clock
4242
import Data.Function (on)
4343
import Data.Maybe (fromMaybe)
4444
import Data.FileEmbed (embedFile)
45+
import Data.Traversable (traverse)
4546

4647
import Control.Monad.Error
4748
import Control.Arrow ((&&&))
@@ -138,7 +139,7 @@ class MonadMake m where
138139
-- If timestamps have not changed, the externs file can be used to provide the module's types without
139140
-- having to typecheck the module again.
140141
--
141-
make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(FilePath, Module)] -> [String] -> m Environment
142+
make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(Maybe FilePath, Module)] -> [String] -> m Environment
142143
make outputDir opts ms prefix = do
143144
let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
144145

@@ -149,11 +150,11 @@ make outputDir opts ms prefix = do
149150

150151
jsFile = outputDir </> filePath </> "index.js"
151152
externsFile = outputDir </> filePath </> "externs.purs"
152-
inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap
153+
inputFile = join $ M.lookup moduleName' filePathMap
153154

154155
jsTimestamp <- getTimestamp jsFile
155156
externsTimestamp <- getTimestamp externsFile
156-
inputTimestamp <- getTimestamp inputFile
157+
inputTimestamp <- join <$> traverse getTimestamp inputFile
157158

158159
return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of
159160
(Just t1, Just t2, Just t3) | t1 < min t2 t3 -> s

‎src/Language/PureScript/Parser/Declarations.hs‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -232,13 +232,17 @@ parseModule = do
232232
decls <- mark (P.many (same *> parseDeclaration))
233233
return $ Module name decls exports
234234

235-
parseModulesFromFiles :: [(FilePath, String)] -> Either P.ParseError [(FilePath, Module)]
236-
parseModulesFromFiles input = fmap collect . forM input $ \(filename, content) -> do
237-
ms <- runIndentParser filename parseModules content
235+
-- |
236+
-- Parse a collection of modules
237+
--
238+
parseModulesFromFiles :: [(Maybe FilePath, String)] -> Either P.ParseError [(Maybe FilePath, Module)]
239+
parseModulesFromFiles input =
240+
fmap collect . forM input $ \(filename, content) -> do
241+
ms <- runIndentParser (fromMaybe "" filename) parseModules content
238242
return (filename, ms)
239243
where
240-
collect :: [(FilePath, [Module])] -> [(FilePath, Module)]
241-
collect xs = [ (fp, m) | (fp, ms) <- xs, m <- ms ]
244+
collect :: [(k, [v])] -> [(k, v)]
245+
collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
242246

243247
-- |
244248
-- Parse a collection of modules

‎tests/Main.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -30,14 +30,14 @@ import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirector
3030
import Text.Parsec (ParseError)
3131
import qualified System.IO.UTF8 as U
3232

33-
readInput :: [FilePath] -> IO [(FilePath, String)]
33+
readInput :: [FilePath] -> IO [(Maybe FilePath, String)]
3434
readInput inputFiles = forM inputFiles $ \inputFile -> do
3535
text <- U.readFile inputFile
36-
return (inputFile, text)
36+
return (Just inputFile, text)
3737

3838
loadPrelude :: Either String (String, String, P.Environment)
3939
loadPrelude =
40-
case P.parseModulesFromFiles [("<prelude>", P.prelude)] of
40+
case P.parseModulesFromFiles [(Nothing, P.prelude)] of
4141
Left parseError -> Left (show parseError)
4242
Right ms -> P.compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) (map snd ms) []
4343

0 commit comments

Comments
 (0)