{-# LANGUAGE OverloadedStrings #-}

module Language.Rzk.VSCode.State where

import           Data.Yaml (FromJSON (..), (.!=), (.:), (.:?))
import qualified Data.Yaml as Y

data ProjectConfig = ProjectConfig
  { ProjectConfig -> [FilePath]
include :: [FilePath]
  , ProjectConfig -> [FilePath]
exclude :: [FilePath]
  } deriving (ProjectConfig -> ProjectConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectConfig -> ProjectConfig -> Bool
$c/= :: ProjectConfig -> ProjectConfig -> Bool
== :: ProjectConfig -> ProjectConfig -> Bool
$c== :: ProjectConfig -> ProjectConfig -> Bool
Eq, Int -> ProjectConfig -> ShowS
[ProjectConfig] -> ShowS
ProjectConfig -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectConfig] -> ShowS
$cshowList :: [ProjectConfig] -> ShowS
show :: ProjectConfig -> FilePath
$cshow :: ProjectConfig -> FilePath
showsPrec :: Int -> ProjectConfig -> ShowS
$cshowsPrec :: Int -> ProjectConfig -> ShowS
Show)

instance FromJSON ProjectConfig where
  parseJSON :: Value -> Parser ProjectConfig
parseJSON (Y.Object Object
v) =
    [FilePath] -> [FilePath] -> ProjectConfig
ProjectConfig   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
v forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"include" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclude" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expected config value to be an object"

-- TODO: Add a "ServerState" data structure for holding the typechecking cache