70 lines
2.0 KiB
Haskell
70 lines
2.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Module (
|
|
Module(..)
|
|
, parse
|
|
) where
|
|
|
|
import Context (CodePath(..), Context(..), Contextual, Path(..))
|
|
import Control.Applicative ((<|>))
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Control.Monad.Reader (asks)
|
|
import Data.Attoparsec.Text (
|
|
Parser, char, parseOnly, sepBy, string, takeTill, takeWhile
|
|
)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text (concat, pack)
|
|
import Prelude hiding (takeWhile)
|
|
import System.Directory (doesFileExist)
|
|
import System.FilePath ((</>), (<.>))
|
|
import Text.Printf (printf)
|
|
|
|
type ImportTree = Int
|
|
data Mapping = Mapping {
|
|
exposedName :: String
|
|
, sourceObject :: String
|
|
}
|
|
|
|
data Module = Module {
|
|
imports :: ImportTree
|
|
, payload :: [Text]
|
|
} deriving Show
|
|
|
|
importParser :: Parser [Mapping]
|
|
importParser =
|
|
string "import" *> space *> pure [] <* space <* char ';'
|
|
where
|
|
space = takeWhile (`elem` [' ', '\t'])
|
|
|
|
treeOf :: [[Mapping]] -> ImportTree
|
|
treeOf = foldl (\n l -> n + length l) 0
|
|
|
|
moduleParser :: Parser Module
|
|
moduleParser = Module
|
|
<$> (treeOf <$> importParser `sepBy` blank)
|
|
<*> line `sepBy` eol
|
|
where
|
|
eol = string "\r\n" <|> string "\r" <|> string "\n"
|
|
blank = takeWhile (`elem` [' ', '\t', '\r', '\n'])
|
|
line = takeTill (`elem` ['\r', '\n'])
|
|
|
|
parse :: Path -> Contextual (Either String Module)
|
|
parse path = do
|
|
searchPath <- asks codePaths
|
|
maybeSource <- find searchPath path
|
|
case maybeSource of
|
|
Nothing -> return . Left $
|
|
printf "Module %s not found in paths : %s" (show path) (show searchPath)
|
|
Just source ->
|
|
parseOnly moduleParser . Text.pack <$> liftIO (readFile source)
|
|
|
|
find :: MonadIO m => CodePath -> Path -> m (Maybe FilePath)
|
|
find (CodePath []) _ = return Nothing
|
|
find (CodePath (dir:otherDirs)) path@(Path components) = do
|
|
fileExists <- liftIO $ doesFileExist filePath
|
|
if fileExists
|
|
then return (Just filePath)
|
|
else find (CodePath otherDirs) path
|
|
where
|
|
filePath = foldl (</>) dir components <.> "js"
|