{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeApplications  #-}

module Rzk.Main where

import           Control.Monad        (forM, when)
import           Data.List            (sort)
import qualified Data.Yaml            as Yaml
import           System.Directory     (doesPathExist)
import           System.FilePath.Glob (glob)

import qualified Language.Rzk.Syntax  as Rzk
import           Rzk.Project.Config
import           Rzk.TypeCheck



parseStdin :: IO Rzk.Module
parseStdin :: IO Module
parseStdin = do
  result <- String -> Either String Module
Rzk.parseModule (String -> Either String Module)
-> IO String -> IO (Either String Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getContents
  case result of
    Left String
err -> do
      String -> IO ()
putStrLn (String
"An error occurred when parsing stdin")
      String -> IO Module
forall a. HasCallStack => String -> a
error String
err
    Right Module
rzkModule -> Module -> IO Module
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Module
rzkModule

-- | Finds matches to the given pattern in the current working directory.
-- **NOTE:** throws exception when 'glob' returns an empty list.
globNonEmpty :: FilePath -> IO [FilePath]
globNonEmpty :: String -> IO [String]
globNonEmpty String
path = do
  String -> IO [String]
glob String
path IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    []    -> String -> IO [String]
forall a. HasCallStack => String -> a
error (String
"File(s) not found at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path)
    [String]
paths -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
paths)

extractFilesFromRzkYaml :: FilePath -> IO [FilePath]
extractFilesFromRzkYaml :: String -> IO [String]
extractFilesFromRzkYaml String
rzkYamlPath = do
  eitherConfig <- forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither @ProjectConfig String
rzkYamlPath
  case eitherConfig of
    Left ParseException
err -> do
      String -> IO [String]
forall a. HasCallStack => String -> a
error (String
"Invalid or missing rzk.yaml: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseException -> String
Yaml.prettyPrintParseException ParseException
err)
    Right ProjectConfig{[String]
include :: [String]
exclude :: [String]
exclude :: ProjectConfig -> [String]
include :: ProjectConfig -> [String]
..} -> do
      [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
include

-- | Given a list of file paths (possibly including globs), expands the globs (if any)
-- or tries to read the list of files from the rzk.yaml file (if no paths are given).
-- Glob patterns in rzk.yaml are also expanded.
expandRzkPathsOrYaml :: [FilePath] -> IO [FilePath]
expandRzkPathsOrYaml :: [String] -> IO [String]
expandRzkPathsOrYaml = \case
    [] -> do
      let rzkYamlPath :: String
rzkYamlPath = String
"rzk.yaml"
      rzkYamlExists <- String -> IO Bool
doesPathExist String
rzkYamlPath
      if rzkYamlExists
        then do
          paths <- extractFilesFromRzkYaml rzkYamlPath
          when (null paths) (error $ "No files found in " <> rzkYamlPath)
          expandRzkPathsOrYaml paths
        else error ("No paths given and no " <> rzkYamlPath <> " found")
    [String]
paths -> (String -> IO [String]) -> [String] -> IO [String]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> IO [String]
globNonEmpty [String]
paths

parseRzkFilesOrStdin :: [FilePath] -> IO [(FilePath, Rzk.Module)]
parseRzkFilesOrStdin :: [String] -> IO [(String, Module)]
parseRzkFilesOrStdin = \case
  -- if no paths are given — read from stdin
  -- TODO: reuse the `expandRzkPathsOrYaml` function
  [] -> do
    let rzkYamlPath :: String
rzkYamlPath = String
"rzk.yaml"
    rzkYamlExists <- String -> IO Bool
doesPathExist String
rzkYamlPath
    if rzkYamlExists
      then do
        putStrLn ("Using Rzk project stucture specified in " <> rzkYamlPath)
        paths <- extractFilesFromRzkYaml rzkYamlPath
        when (null paths) (error $ "No Rzk files specified in the config file at " <> rzkYamlPath)
        parseRzkFilesOrStdin paths
      else do
        rzkModule <- parseStdin
        return [("<stdin>", rzkModule)]
  -- otherwise — parse all given files in given order
  [String]
paths -> do
    expandedPaths <- (String -> IO [String]) -> [String] -> IO [String]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> IO [String]
globNonEmpty [String]
paths
    forM expandedPaths $ \String
path -> do
      String -> IO ()
putStrLn (String
"Loading file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path)
      result <- String -> Either String Module
Rzk.parseModule (String -> Either String Module)
-> IO String -> IO (Either String Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
path
      case result of
        Left String
err -> do
          String -> IO ()
putStrLn (String
"An error occurred when parsing file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path)
          String -> IO (String, Module)
forall a. HasCallStack => String -> a
error String
err
        Right Module
rzkModule -> (String, Module) -> IO (String, Module)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
path, Module
rzkModule)

typecheckString :: String -> Either String String
typecheckString :: String -> Either String String
typecheckString String
moduleString = do
  rzkModule <- String -> Either String Module
Rzk.parseModule String
moduleString
  case defaultTypeCheck (typecheckModules [rzkModule]) of
    Left TypeErrorInScopedContext VarIdent
err -> String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      [ String
"An error occurred when typechecking!"
      , String
"Rendering type error... (this may take a few seconds)"
      , [String] -> String
unlines
        [ String
"Type Error:"
        , OutputDirection -> TypeErrorInScopedContext VarIdent -> String
ppTypeErrorInScopedContext' OutputDirection
BottomUp TypeErrorInScopedContext VarIdent
err
        ]
      ]
    Right [Decl']
_ -> String -> Either String String
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Everything is ok!"