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