1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
-----------------------------------------------------------------------------
--
-- Module : Foreign
-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
-- License : MIT
--
-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
-- Stability : experimental
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
module Language.PureScript.Parser.JS
( ForeignJS()
, parseForeignModulesFromFiles
) where
import Control.Applicative ((*>), (<*))
import Control.Monad (forM_, when, msum)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Writer.Class (MonadWriter(..))
import Data.Function (on)
import Data.List (sortBy, groupBy)
import Language.PureScript.Errors
import Language.PureScript.Names
import Language.PureScript.Parser.Common
import Language.PureScript.Parser.Lexer
import Prelude hiding (lex)
import qualified Data.Map as M
import qualified Text.Parsec as PS
type ForeignJS = String
parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
=> [(FilePath, ForeignJS)]
-> m (M.Map ModuleName FilePath)
parseForeignModulesFromFiles files = do
foreigns <- parU files $ \(path, file) ->
case findModuleName (lines file) of
Just name -> return (name, path)
Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)
let grouped = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) foreigns
forM_ grouped $ \grp ->
when (length grp > 1) $ do
let mn = fst (head grp)
paths = map snd grp
tell $ errorMessage $ MultipleFFIModules mn paths
return $ M.fromList foreigns
findModuleName :: [String] -> Maybe ModuleName
findModuleName = msum . map parseComment
where
parseComment :: String -> Maybe ModuleName
parseComment s = either (const Nothing) Just $
lex "" s >>= runTokenParser "" (symbol' "//" *> reserved "module" *> moduleName <* PS.eof)
|
