{-# LANGUAGE OverloadedStrings #-}

-- | Things related to HIndent configuration.
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

-- | Configurations shared among the different styles. Styles may pay
-- attention to or completely disregard this configuration.
data Config = Config
  { Config -> Int64
configMaxColumns :: !Int64 -- ^ Maximum columns to fit code into ideally.
  , Config -> Int64
configIndentSpaces :: !Int64 -- ^ How many spaces to indent?
  , Config -> Bool
configTrailingNewline :: !Bool -- ^ End with a newline.
  , Config -> Bool
configSortImports :: !Bool -- ^ Sort imports in groups.
  , Config -> [FilePath]
configLineBreaks :: [String] -- ^ Break line when meets these operators.
  , Config -> [Extension]
configExtensions :: [Extension]
      -- ^ Extra language extensions enabled by default.
  }

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"

-- | Default style configuration.
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 = []
    }

-- | Read config from a config file, or return 'defaultConfig'.
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