63 lines
2.0 KiB
Haskell
63 lines
2.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module Module (
|
|
Environment
|
|
, Failable
|
|
, Log
|
|
, Module(..)
|
|
, parse
|
|
) where
|
|
|
|
import Context (CodePath(..), Context(..), Contextual, Path(..))
|
|
import Control.Monad.Except (MonadError(..))
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Control.Monad.RWS (MonadWriter, asks)
|
|
import Data.Attoparsec.Text (parseOnly)
|
|
import qualified Data.Set as Set (empty, insert, toList)
|
|
import qualified Data.Text as Text (pack)
|
|
import Module.Environment (HasEnvironment)
|
|
import Module.File (File(..))
|
|
import qualified Module.File (parser)
|
|
import Module.Imports (Reference(..), recurse)
|
|
import Prelude hiding (takeWhile)
|
|
import System.Directory (doesFileExist)
|
|
import System.FilePath ((</>), (<.>))
|
|
import Text.Printf (printf)
|
|
|
|
data Module = Module {
|
|
file :: Module.File.File
|
|
, dependencies :: [Path]
|
|
}
|
|
|
|
type Environment = HasEnvironment Module
|
|
type Log = MonadWriter [String]
|
|
type Failable = MonadError String
|
|
|
|
build :: File -> Module
|
|
build file = Module {file, dependencies}
|
|
where
|
|
dependencies =
|
|
Set.toList . recurse pushDependency Set.empty $ imports file
|
|
pushDependency set _ ref = Set.insert (modulePath ref) set
|
|
|
|
parse :: (Contextual m, MonadIO m, Failable m) => Path -> m Module
|
|
parse path = do
|
|
searchPath <- asks codePaths
|
|
maybeSource <- find searchPath path
|
|
case maybeSource of
|
|
Nothing -> throwError $
|
|
printf "Module %s not found in paths : %s" (show path) (show searchPath)
|
|
Just source -> either throwError (return . build) =<<
|
|
parseOnly Module.File.parser . 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"
|