{-# 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"