{-# LANGUAGE OverloadedStrings #-}
module HIndent.Config
( Config(..)
, defaultConfig
, getConfig
) where
import Control.Applicative
import Data.Int
import Data.Maybe
import Data.Yaml
import qualified Data.Yaml as Y
import HIndent.LanguageExtension.Conversion
import HIndent.LanguageExtension.Types
import qualified HIndent.Path.Find as Path
import Path
import qualified Path.IO as Path
data Config = Config
{ Config -> Int64
configMaxColumns :: !Int64
, Config -> Int64
configIndentSpaces :: !Int64
, Config -> Bool
configTrailingNewline :: !Bool
, Config -> Bool
configSortImports :: !Bool
, Config -> [FilePath]
configLineBreaks :: [String]
, Config -> [Extension]
configExtensions :: [Extension]
}
instance FromJSON Config where
parseJSON :: Value -> Parser Config
parseJSON (Y.Object Object
v) =
Int64
-> Int64 -> Bool -> Bool -> [FilePath] -> [Extension] -> Config
Config (Int64
-> Int64 -> Bool -> Bool -> [FilePath] -> [Extension] -> Config)
-> Parser Int64
-> Parser
(Int64 -> Bool -> Bool -> [FilePath] -> [Extension] -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Maybe Int64 -> Int64) -> Parser (Maybe Int64) -> Parser Int64
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe (Config -> Int64
configMaxColumns Config
defaultConfig)) (Object
v Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"line-length") Parser
(Int64 -> Bool -> Bool -> [FilePath] -> [Extension] -> Config)
-> Parser Int64
-> Parser (Bool -> Bool -> [FilePath] -> [Extension] -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe Int64 -> Int64) -> Parser (Maybe Int64) -> Parser Int64
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe (Config -> Int64
configIndentSpaces Config
defaultConfig))
(Object
v Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"indent-size" Parser (Maybe Int64)
-> Parser (Maybe Int64) -> Parser (Maybe Int64)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"tab-size") Parser (Bool -> Bool -> [FilePath] -> [Extension] -> Config)
-> Parser Bool
-> Parser (Bool -> [FilePath] -> [Extension] -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Config -> Bool
configTrailingNewline Config
defaultConfig))
(Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"force-trailing-newline") Parser (Bool -> [FilePath] -> [Extension] -> Config)
-> Parser Bool -> Parser ([FilePath] -> [Extension] -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Config -> Bool
configSortImports Config
defaultConfig)) (Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"sort-imports") Parser ([FilePath] -> [Extension] -> Config)
-> Parser [FilePath] -> Parser ([Extension] -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Maybe [FilePath] -> [FilePath])
-> Parser (Maybe [FilePath]) -> Parser [FilePath]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe (Config -> [FilePath]
configLineBreaks Config
defaultConfig)) (Object
v Object -> Key -> Parser (Maybe [FilePath])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"line-breaks") Parser ([Extension] -> Config)
-> Parser [Extension] -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
((FilePath -> Parser Extension) -> [FilePath] -> Parser [Extension]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> Parser Extension
forall {f :: * -> *}. Applicative f => FilePath -> f Extension
convertExt ([FilePath] -> Parser [Extension])
-> (Maybe [FilePath] -> [FilePath])
-> Maybe [FilePath]
-> Parser [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FilePath] -> Parser [Extension])
-> Parser (Maybe [FilePath]) -> Parser [Extension]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v Object -> Key -> Parser (Maybe [FilePath])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Y..:? Key
"extensions")
where
convertExt :: FilePath -> f Extension
convertExt FilePath
x =
case FilePath -> Maybe Extension
strToExt FilePath
x of
Just Extension
x' -> Extension -> f Extension
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Extension
x'
Maybe Extension
Nothing -> FilePath -> f Extension
forall a. HasCallStack => FilePath -> a
error (FilePath -> f Extension) -> FilePath -> f Extension
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknow extension: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
x
parseJSON Value
_ = FilePath -> Parser Config
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expected Object for Config value"
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
Config
{ configMaxColumns :: Int64
configMaxColumns = Int64
80
, configIndentSpaces :: Int64
configIndentSpaces = Int64
2
, configTrailingNewline :: Bool
configTrailingNewline = Bool
True
, configSortImports :: Bool
configSortImports = Bool
True
, configLineBreaks :: [FilePath]
configLineBreaks = []
, configExtensions :: [Extension]
configExtensions = []
}
getConfig :: IO Config
getConfig :: IO Config
getConfig = do
Path Abs Dir
cur <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.getCurrentDir
Path Abs Dir
homeDir <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.getHomeDir
Maybe (Path Abs File)
mfile <-
Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> IO (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
Path.findFileUp
Path Abs Dir
cur
((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".hindent.yaml") (FilePath -> Bool)
-> (Path Abs File -> FilePath) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath)
-> (Path Abs File -> Path Rel File) -> Path Abs File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename)
(Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
homeDir)
case Maybe (Path Abs File)
mfile of
Maybe (Path Abs File)
Nothing -> Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig
Just Path Abs File
file -> do
Either ParseException Config
result <- FilePath -> IO (Either ParseException Config)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Y.decodeFileEither (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
file)
case Either ParseException Config
result of
Left ParseException
e -> FilePath -> IO Config
forall a. HasCallStack => FilePath -> a
error (ParseException -> FilePath
forall a. Show a => a -> FilePath
show ParseException
e)
Right Config
config -> Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config