{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module SJW.Module (
      Environment
    , Log
    , Module(..)
    , Modules(..)
    , parse
    , register
  ) where

import SJW.Source (CodePath(..), Source(..), HasSource, Path(..))
import Control.Monad.Except (MonadError(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.RWS (MonadState, MonadWriter, asks, modify)
import Data.Attoparsec.Text (parseOnly)
import Data.Map (Map)
import qualified Data.Map as Map (insert)
import Data.Set (Set)
import qualified Data.Set as Set (empty, insert)
import qualified Data.Text as Text (pack)
import SJW.Dependencies (Failable)
import SJW.Module.File (File(..))
import qualified SJW.Module.File as File (parser)
import SJW.Module.Imports (Reference(..), recurse)
import Prelude hiding (takeWhile)
import System.Directory (doesFileExist)
import System.FilePath ((</>), (<.>))
import Text.Printf (printf)

data Module = Module {
      Module -> File
file :: File
    , Module -> Set Path
dependencies :: Set Path
  }

newtype Modules = Modules {
    Modules -> Map Path Module
modules :: Map Path Module
  }

type Environment = MonadState Modules
type Log = MonadWriter [String]

register :: Environment m => Path -> Module -> m ()
register :: Path -> Module -> m ()
register Path
path Module
module_ = (Modules -> Modules) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Modules -> Modules) -> m ()) -> (Modules -> Modules) -> m ()
forall a b. (a -> b) -> a -> b
$
  \(Modules Map Path Module
modules) -> Map Path Module -> Modules
Modules (Map Path Module -> Modules) -> Map Path Module -> Modules
forall a b. (a -> b) -> a -> b
$ Path -> Module -> Map Path Module -> Map Path Module
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Path
path Module
module_ Map Path Module
modules

build :: File -> Module
build :: File -> Module
build File
file = Module :: File -> Set Path -> Module
Module {File
file :: File
file :: File
file, Set Path
dependencies :: Set Path
dependencies :: Set Path
dependencies}
  where
    dependencies :: Set Path
dependencies = (Set Path -> [String] -> Reference -> Set Path)
-> Set Path -> Tree -> Set Path
forall a. (a -> [String] -> Reference -> a) -> a -> Tree -> a
recurse Set Path -> [String] -> Reference -> Set Path
forall p. Set Path -> p -> Reference -> Set Path
pushDependency Set Path
forall a. Set a
Set.empty (Tree -> Set Path) -> Tree -> Set Path
forall a b. (a -> b) -> a -> b
$ File -> Tree
imports File
file
    pushDependency :: Set Path -> p -> Reference -> Set Path
pushDependency Set Path
set p
_ Reference
ref = Path -> Set Path -> Set Path
forall a. Ord a => a -> Set a -> Set a
Set.insert (Reference -> Path
modulePath Reference
ref) Set Path
set

parse :: (HasSource m, MonadIO m, Failable m) => Bool -> Path -> m Module
parse :: Bool -> Path -> m Module
parse Bool
isMain Path
path = do
  CodePath
searchPath <- (Source -> CodePath) -> m CodePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Source -> CodePath
code
  String
filePath <- (CodePath, CodePath) -> Path -> m String
forall (m :: * -> *).
(Failable m, MonadIO m) =>
(CodePath, CodePath) -> Path -> m String
find ([String] -> CodePath
CodePath [], CodePath
searchPath) Path
path
  Text
source <- String -> Text
Text.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
readFile String
filePath)
  (String -> m Module)
-> (File -> m Module) -> Either String File -> m Module
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Module
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Module -> m Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> m Module) -> (File -> Module) -> File -> m Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> Module
build) (Either String File -> m Module) -> Either String File -> m Module
forall a b. (a -> b) -> a -> b
$
    Parser File -> Text -> Either String File
forall a. Parser a -> Text -> Either String a
parseOnly (Bool -> Parser File
File.parser Bool
isMain) Text
source

find :: (Failable m, MonadIO m) => (CodePath, CodePath) -> Path -> m FilePath
find :: (CodePath, CodePath) -> Path -> m String
find (CodePath
stack, CodePath []) Path
path = String -> m String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$
  String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Module %s not found in paths : %s" (Path -> String
forall a. Show a => a -> String
show Path
path) (CodePath -> String
forall a. Show a => a -> String
show (CodePath -> String) -> CodePath -> String
forall a b. (a -> b) -> a -> b
$ CodePath
stack)
find (CodePath [String]
stackedDirs, CodePath (String
dir:[String]
otherDirs)) path :: Path
path@(Path [String]
components) = do
  Bool
fileExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
filePath
  if Bool
fileExists
  then String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filePath
  else (CodePath, CodePath) -> Path -> m String
forall (m :: * -> *).
(Failable m, MonadIO m) =>
(CodePath, CodePath) -> Path -> m String
find ([String] -> CodePath
CodePath (String
dirString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
stackedDirs), [String] -> CodePath
CodePath [String]
otherDirs) Path
path
  where
    filePath :: String
filePath = (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
(</>) String
dir [String]
components String -> String -> String
<.> String
"js"