{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module SJW (
      Source
    , Path(..)
    , compile
    , mainIs
    , source
    , sourceCode
  ) where

import Control.Applicative ((<|>))
import Control.Monad.Except (MonadError(..), runExceptT)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.RWS (evalRWST)
import qualified Data.Map as Map (empty)
import Data.Text (Text)
import qualified SJW.Compiler as Compiler (main)
import SJW.Dependencies (Failable)
import SJW.Module (Modules(..))
import SJW.Source (CodePath(..), Source(..), Path(..), source)
import System.Directory (doesDirectoryExist)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import System.IO (stderr, hPutStrLn)
import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
import Text.Printf (printf)

type Result = Either String (Text, [String])

compile :: Source -> IO Result
compile :: Source -> IO Result
compile Source
inputSource = ExceptT String IO (Text, [String]) -> IO Result
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO (Text, [String]) -> IO Result)
-> ExceptT String IO (Text, [String]) -> IO Result
forall a b. (a -> b) -> a -> b
$ do
  [String]
checkedPackages <- [String] -> ExceptT String IO [String]
forall (m :: * -> *).
(MonadIO m, Failable m) =>
[String] -> m [String]
check [String]
packages
  let checkedSource :: Source
checkedSource = Source
inputSource {code :: CodePath
code = [String] -> CodePath
CodePath [String]
checkedPackages}
  RWST Source [String] Modules (ExceptT String IO) Text
-> Source -> Modules -> ExceptT String IO (Text, [String])
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (a, w)
evalRWST RWST Source [String] Modules (ExceptT String IO) Text
forall (m :: * -> *). Compiler m => m Text
Compiler.main Source
checkedSource Modules
emptyEnvironment
  where
    CodePath [String]
packages = Source -> CodePath
code Source
inputSource
    emptyEnvironment :: Modules
emptyEnvironment = Modules :: Map Path Module -> Modules
Modules {
        modules :: Map Path Module
modules = Map Path Module
forall k a. Map k a
Map.empty
      }

sourceCode :: Result -> IO (Maybe Text)
sourceCode :: Result -> IO (Maybe Text)
sourceCode (Left String
errorMessage) = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
errorMessage IO () -> IO (Maybe Text) -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
sourceCode (Right (Text
output, [String]
logs)) =
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr) [String]
logs IO () -> IO (Maybe Text) -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output)

mainIs :: Source -> String -> Source
mainIs :: Source -> String -> Source
mainIs Source
context String
dotSeparated = Source
context {mainModule :: Path
mainModule = String -> Path
forall a. Read a => String -> a
read String
dotSeparated}

(<||>) :: (Monad m) => m (Maybe a) -> a -> m a
<||> :: m (Maybe a) -> a -> m a
(<||>) m (Maybe a)
value a
defaultValue = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
defaultValue a -> a
forall a. a -> a
id (Maybe a -> a) -> m (Maybe a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
value

dbDirectory :: MonadIO m => m FilePath
dbDirectory :: m String
dbDirectory = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
  String
unixHome <- UserEntry -> String
homeDirectory (UserEntry -> String) -> IO UserEntry -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserID -> IO UserEntry
getUserEntryForID (UserID -> IO UserEntry) -> IO UserID -> IO UserEntry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UserID
getRealUserID)
  String
homeDB <- String -> IO (Maybe String)
lookupEnv String
"HOME" IO (Maybe String) -> String -> IO String
forall (m :: * -> *) a. Monad m => m (Maybe a) -> a -> m a
<||> String
unixHome
  String -> IO (Maybe String)
lookupEnv String
"SJW_PACKAGE_DB" IO (Maybe String) -> String -> IO String
forall (m :: * -> *) a. Monad m => m (Maybe a) -> a -> m a
<||> (String
homeDB String -> String -> String
</> String
".sjw")

checkPath :: MonadIO m => FilePath -> m (Maybe FilePath)
checkPath :: String -> m (Maybe String)
checkPath String
filePath = IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
  Bool
directoryExists <- String -> IO Bool
doesDirectoryExist String
filePath
  Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
directoryExists then String -> Maybe String
forall a. a -> Maybe a
Just String
filePath else Maybe String
forall a. Maybe a
Nothing

check :: (MonadIO m, Failable m) => [String] -> m [FilePath]
check :: [String] -> m [String]
check [String]
names = do
  String
db <- m String
forall (m :: * -> *). MonadIO m => m String
dbDirectory
  (String -> m String) -> [String] -> m [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> String -> m String
pathOrPackageName String
db) [String]
names
  where
    notFound :: String -> m a
notFound = String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> (String -> String) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s: package and directory not found"
    pathOrPackageName :: String -> String -> m String
pathOrPackageName String
db String
name =
      Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe String -> Maybe String -> Maybe String)
-> m (Maybe String) -> m (Maybe String -> Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
checkPath String
name m (Maybe String -> Maybe String)
-> m (Maybe String) -> m (Maybe String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> m (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
checkPath (String
db String -> String -> String
</> String
name)
      m (Maybe String) -> (Maybe String -> m String) -> m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m String -> (String -> m String) -> Maybe String -> m String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m String
forall a. String -> m a
notFound String
name) String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return