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

module Rzk.Main where

import           Control.Monad        (forM, when)
import           Data.List            (sort)
import qualified Data.Text            as T
import qualified Data.Text.IO         as T
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 <- Text -> Either Text Module
Rzk.parseModule (Text -> Either Text Module) -> IO Text -> IO (Either Text Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
T.getContents
  case result of
    Left Text
err -> do
      [Char] -> IO ()
putStrLn [Char]
"An error occurred when parsing stdin"
      [Char] -> IO Module
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
T.unpack Text
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 :: [Char] -> IO [[Char]]
globNonEmpty [Char]
path = do
  [Char] -> IO [[Char]]
glob [Char]
path IO [[Char]] -> ([[Char]] -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    []    -> [Char] -> IO [[Char]]
forall a. HasCallStack => [Char] -> a
error ([Char]
"File(s) not found at " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path)
    [[Char]]
paths -> [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort [[Char]]
paths)

extractFilesFromRzkYaml :: FilePath -> IO [FilePath]
extractFilesFromRzkYaml :: [Char] -> IO [[Char]]
extractFilesFromRzkYaml [Char]
rzkYamlPath = do
  eitherConfig <- forall a. FromJSON a => [Char] -> IO (Either ParseException a)
Yaml.decodeFileEither @ProjectConfig [Char]
rzkYamlPath
  case eitherConfig of
    Left ParseException
err -> do
      [Char] -> IO [[Char]]
forall a. HasCallStack => [Char] -> a
error ([Char]
"Invalid or missing rzk.yaml: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ParseException -> [Char]
Yaml.prettyPrintParseException ParseException
err)
    Right ProjectConfig{[[Char]]
include :: [[Char]]
exclude :: [[Char]]
exclude :: ProjectConfig -> [[Char]]
include :: ProjectConfig -> [[Char]]
..} -> do
      [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
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 :: [[Char]] -> IO [[Char]]
expandRzkPathsOrYaml = \case
    [] -> do
      let rzkYamlPath :: [Char]
rzkYamlPath = [Char]
"rzk.yaml"
      rzkYamlExists <- [Char] -> IO Bool
doesPathExist [Char]
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")
    [[Char]]
paths -> ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Char] -> IO [[Char]]
globNonEmpty [[Char]]
paths

parseRzkFilesOrStdin :: [FilePath] -> IO [(FilePath, Rzk.Module)]
parseRzkFilesOrStdin :: [[Char]] -> IO [([Char], Module)]
parseRzkFilesOrStdin = \case
  -- if no paths are given — read from stdin
  -- TODO: reuse the `expandRzkPathsOrYaml` function
  [] -> do
    let rzkYamlPath :: [Char]
rzkYamlPath = [Char]
"rzk.yaml"
    rzkYamlExists <- [Char] -> IO Bool
doesPathExist [Char]
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
  [[Char]]
paths -> do
    expandedPaths <- ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Char] -> IO [[Char]]
globNonEmpty [[Char]]
paths
    forM expandedPaths $ \[Char]
path -> do
      [Char] -> IO ()
putStrLn ([Char]
"Loading file " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path)
      result <- Text -> Either Text Module
Rzk.parseModule (Text -> Either Text Module) -> IO Text -> IO (Either Text Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
path
      case result of
        Left Text
err -> do
          [Char] -> IO ()
putStrLn ([Char]
"An error occurred when parsing file " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path)
          [Char] -> IO ([Char], Module)
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
T.unpack Text
err)
        Right Module
rzkModule -> ([Char], Module) -> IO ([Char], Module)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
path, Module
rzkModule)

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