{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Configuration options used by the tool.
module Ormolu.Config
  ( Config (..),
    ColorMode (..),
    RegionIndices (..),
    RegionDeltas (..),
    SourceType (..),
    defaultConfig,
    regionIndicesToDeltas,
    DynOption (..),
    dynOptionToLocatedStr,

    -- * Fourmolu configuration
    PrinterOpts (..),
    PrinterOptsPartial,
    PrinterOptsTotal,
    defaultPrinterOpts,
    fillMissingPrinterOpts,
    CommaStyle (..),
    FunctionArrowsStyle (..),
    HaddockPrintStyle (..),
    HaddockPrintStyleModule (..),
    ImportExportStyle (..),
    LetStyle (..),
    InStyle (..),
    Unicode (..),
    parsePrinterOptsCLI,
    parsePrinterOptType,

    -- ** Loading Fourmolu configuration
    loadConfigFile,
    configFileName,
    FourmoluConfig (..),
    emptyConfig,
    ConfigFileLoadResult (..),
  )
where

import Control.Monad (forM)
import Data.Aeson ((.!=), (.:?))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Functor.Identity (Identity (..))
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (fromString)
import qualified Data.Yaml as Yaml
import Distribution.Types.PackageName (PackageName)
import GHC.Generics (Generic)
import qualified GHC.Types.SrcLoc as GHC
import Ormolu.Config.Gen
import Ormolu.Fixity (FixityMap)
import Ormolu.Fixity.Parser (parseFixityDeclaration)
import Ormolu.Terminal (ColorMode (..))
import System.Directory
  ( XdgDirectory (XdgConfig),
    findFile,
    getXdgDirectory,
    makeAbsolute,
  )
import System.FilePath (splitPath, (</>))
import Text.Megaparsec (errorBundlePretty)

-- | Type of sources that can be formatted by Ormolu.
data SourceType
  = -- | Consider the input as a regular Haskell module
    ModuleSource
  | -- | Consider the input as a Backpack module signature
    SignatureSource
  deriving (SourceType -> SourceType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceType -> SourceType -> Bool
$c/= :: SourceType -> SourceType -> Bool
== :: SourceType -> SourceType -> Bool
$c== :: SourceType -> SourceType -> Bool
Eq, Int -> SourceType -> ShowS
[SourceType] -> ShowS
SourceType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceType] -> ShowS
$cshowList :: [SourceType] -> ShowS
show :: SourceType -> String
$cshow :: SourceType -> String
showsPrec :: Int -> SourceType -> ShowS
$cshowsPrec :: Int -> SourceType -> ShowS
Show)

-- | Ormolu configuration.
data Config region = Config
  { -- | Dynamic options to pass to GHC parser
    forall region. Config region -> [DynOption]
cfgDynOptions :: ![DynOption],
    -- | Fixity overrides
    forall region. Config region -> FixityMap
cfgFixityOverrides :: FixityMap,
    -- | Known dependencies, if any
    forall region. Config region -> Set PackageName
cfgDependencies :: !(Set PackageName),
    -- | Do formatting faster but without automatic detection of defects
    forall region. Config region -> Bool
cfgUnsafe :: !Bool,
    -- | Output information useful for debugging
    forall region. Config region -> Bool
cfgDebug :: !Bool,
    -- | Checks if re-formatting the result is idempotent
    forall region. Config region -> Bool
cfgCheckIdempotence :: !Bool,
    -- | How to parse the input (regular haskell module or Backpack file)
    forall region. Config region -> SourceType
cfgSourceType :: !SourceType,
    -- | Whether to use colors and other features of ANSI terminals
    forall region. Config region -> ColorMode
cfgColorMode :: !ColorMode,
    -- | Region selection
    forall region. Config region -> region
cfgRegion :: !region,
    forall region. Config region -> PrinterOptsTotal
cfgPrinterOpts :: !PrinterOptsTotal
  }
  deriving (Config region -> Config region -> Bool
forall region. Eq region => Config region -> Config region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config region -> Config region -> Bool
$c/= :: forall region. Eq region => Config region -> Config region -> Bool
== :: Config region -> Config region -> Bool
$c== :: forall region. Eq region => Config region -> Config region -> Bool
Eq, Int -> Config region -> ShowS
forall region. Show region => Int -> Config region -> ShowS
forall region. Show region => [Config region] -> ShowS
forall region. Show region => Config region -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config region] -> ShowS
$cshowList :: forall region. Show region => [Config region] -> ShowS
show :: Config region -> String
$cshow :: forall region. Show region => Config region -> String
showsPrec :: Int -> Config region -> ShowS
$cshowsPrec :: forall region. Show region => Int -> Config region -> ShowS
Show, forall a b. a -> Config b -> Config a
forall a b. (a -> b) -> Config a -> Config b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Config b -> Config a
$c<$ :: forall a b. a -> Config b -> Config a
fmap :: forall a b. (a -> b) -> Config a -> Config b
$cfmap :: forall a b. (a -> b) -> Config a -> Config b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall region x. Rep (Config region) x -> Config region
forall region x. Config region -> Rep (Config region) x
$cto :: forall region x. Rep (Config region) x -> Config region
$cfrom :: forall region x. Config region -> Rep (Config region) x
Generic)

-- | Region selection as the combination of start and end line numbers.
data RegionIndices = RegionIndices
  { -- | Start line of the region to format
    RegionIndices -> Maybe Int
regionStartLine :: !(Maybe Int),
    -- | End line of the region to format
    RegionIndices -> Maybe Int
regionEndLine :: !(Maybe Int)
  }
  deriving (RegionIndices -> RegionIndices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegionIndices -> RegionIndices -> Bool
$c/= :: RegionIndices -> RegionIndices -> Bool
== :: RegionIndices -> RegionIndices -> Bool
$c== :: RegionIndices -> RegionIndices -> Bool
Eq, Int -> RegionIndices -> ShowS
[RegionIndices] -> ShowS
RegionIndices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegionIndices] -> ShowS
$cshowList :: [RegionIndices] -> ShowS
show :: RegionIndices -> String
$cshow :: RegionIndices -> String
showsPrec :: Int -> RegionIndices -> ShowS
$cshowsPrec :: Int -> RegionIndices -> ShowS
Show)

-- | Region selection as the length of the literal prefix and the literal
-- suffix.
data RegionDeltas = RegionDeltas
  { -- | Prefix length in number of lines
    RegionDeltas -> Int
regionPrefixLength :: !Int,
    -- | Suffix length in number of lines
    RegionDeltas -> Int
regionSuffixLength :: !Int
  }
  deriving (RegionDeltas -> RegionDeltas -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegionDeltas -> RegionDeltas -> Bool
$c/= :: RegionDeltas -> RegionDeltas -> Bool
== :: RegionDeltas -> RegionDeltas -> Bool
$c== :: RegionDeltas -> RegionDeltas -> Bool
Eq, Int -> RegionDeltas -> ShowS
[RegionDeltas] -> ShowS
RegionDeltas -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegionDeltas] -> ShowS
$cshowList :: [RegionDeltas] -> ShowS
show :: RegionDeltas -> String
$cshow :: RegionDeltas -> String
showsPrec :: Int -> RegionDeltas -> ShowS
$cshowsPrec :: Int -> RegionDeltas -> ShowS
Show)

-- | Default @'Config' 'RegionIndices'@.
defaultConfig :: Config RegionIndices
defaultConfig :: Config RegionIndices
defaultConfig =
  Config
    { cfgDynOptions :: [DynOption]
cfgDynOptions = [],
      cfgFixityOverrides :: FixityMap
cfgFixityOverrides = forall k a. Map k a
Map.empty,
      cfgDependencies :: Set PackageName
cfgDependencies = forall a. Set a
Set.empty,
      cfgUnsafe :: Bool
cfgUnsafe = Bool
False,
      cfgDebug :: Bool
cfgDebug = Bool
False,
      cfgCheckIdempotence :: Bool
cfgCheckIdempotence = Bool
False,
      cfgSourceType :: SourceType
cfgSourceType = SourceType
ModuleSource,
      cfgColorMode :: ColorMode
cfgColorMode = ColorMode
Auto,
      cfgRegion :: RegionIndices
cfgRegion =
        RegionIndices
          { regionStartLine :: Maybe Int
regionStartLine = forall a. Maybe a
Nothing,
            regionEndLine :: Maybe Int
regionEndLine = forall a. Maybe a
Nothing
          },
      cfgPrinterOpts :: PrinterOptsTotal
cfgPrinterOpts = PrinterOptsTotal
defaultPrinterOpts
    }

-- | Convert 'RegionIndices' into 'RegionDeltas'.
regionIndicesToDeltas ::
  -- | Total number of lines in the input
  Int ->
  -- | Region indices
  RegionIndices ->
  -- | Region deltas
  RegionDeltas
regionIndicesToDeltas :: Int -> RegionIndices -> RegionDeltas
regionIndicesToDeltas Int
total RegionIndices {Maybe Int
regionEndLine :: Maybe Int
regionStartLine :: Maybe Int
regionEndLine :: RegionIndices -> Maybe Int
regionStartLine :: RegionIndices -> Maybe Int
..} =
  RegionDeltas
    { regionPrefixLength :: Int
regionPrefixLength = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
subtract Int
1) Maybe Int
regionStartLine,
      regionSuffixLength :: Int
regionSuffixLength = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
total forall a. Num a => a -> a -> a
-) Maybe Int
regionEndLine
    }

-- | A wrapper for dynamic options.
newtype DynOption = DynOption
  { DynOption -> String
unDynOption :: String
  }
  deriving (DynOption -> DynOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynOption -> DynOption -> Bool
$c/= :: DynOption -> DynOption -> Bool
== :: DynOption -> DynOption -> Bool
$c== :: DynOption -> DynOption -> Bool
Eq, Eq DynOption
DynOption -> DynOption -> Bool
DynOption -> DynOption -> Ordering
DynOption -> DynOption -> DynOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DynOption -> DynOption -> DynOption
$cmin :: DynOption -> DynOption -> DynOption
max :: DynOption -> DynOption -> DynOption
$cmax :: DynOption -> DynOption -> DynOption
>= :: DynOption -> DynOption -> Bool
$c>= :: DynOption -> DynOption -> Bool
> :: DynOption -> DynOption -> Bool
$c> :: DynOption -> DynOption -> Bool
<= :: DynOption -> DynOption -> Bool
$c<= :: DynOption -> DynOption -> Bool
< :: DynOption -> DynOption -> Bool
$c< :: DynOption -> DynOption -> Bool
compare :: DynOption -> DynOption -> Ordering
$ccompare :: DynOption -> DynOption -> Ordering
Ord, Int -> DynOption -> ShowS
[DynOption] -> ShowS
DynOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynOption] -> ShowS
$cshowList :: [DynOption] -> ShowS
show :: DynOption -> String
$cshow :: DynOption -> String
showsPrec :: Int -> DynOption -> ShowS
$cshowsPrec :: Int -> DynOption -> ShowS
Show)

-- | Convert 'DynOption' to @'GHC.Located' 'String'@.
dynOptionToLocatedStr :: DynOption -> GHC.Located String
dynOptionToLocatedStr :: DynOption -> Located String
dynOptionToLocatedStr (DynOption String
o) = forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
GHC.noSrcSpan String
o

----------------------------------------------------------------------------
-- Fourmolu configuration

-- | A version of 'PrinterOpts' where any field can be empty.
-- This corresponds to the information in a config file or in CLI options.
type PrinterOptsPartial = PrinterOpts Maybe

deriving instance Eq PrinterOptsPartial

deriving instance Show PrinterOptsPartial

instance Semigroup PrinterOptsPartial where
  <> :: PrinterOptsPartial -> PrinterOptsPartial -> PrinterOptsPartial
(<>) = forall (f :: * -> *).
Applicative f =>
PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts

instance Monoid PrinterOptsPartial where
  mempty :: PrinterOptsPartial
mempty = PrinterOptsPartial
emptyPrinterOpts

instance Aeson.FromJSON PrinterOptsPartial where
  parseJSON :: Value -> Parser PrinterOptsPartial
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PrinterOpts" forall a b. (a -> b) -> a -> b
$ \Object
o ->
      forall (f :: * -> *).
Applicative f =>
(forall a. PrinterOptsFieldType a => String -> f (Maybe a))
-> f PrinterOptsPartial
parsePrinterOptsJSON (forall a. FromJSON a => Object -> String -> Parser (Maybe a)
parseField Object
o)
    where
      parseField :: (Aeson.FromJSON a) => Aeson.Object -> String -> Aeson.Parser (Maybe a)
      parseField :: forall a. FromJSON a => Object -> String -> Parser (Maybe a)
parseField Object
o String
keyName = do
        let key :: Key
key = forall a. IsString a => String -> a
fromString String
keyName
        Maybe Value
mValue <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
key
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Value
mValue forall a b. (a -> b) -> a -> b
$ \Value
value ->
          forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
value forall a. Parser a -> JSONPathElement -> Parser a
Aeson.<?> Key -> JSONPathElement
Aeson.Key Key
key

-- | A version of 'PrinterOpts' without empty fields.
type PrinterOptsTotal = PrinterOpts Identity

deriving instance Eq PrinterOptsTotal

deriving instance Show PrinterOptsTotal

----------------------------------------------------------------------------
-- Loading Fourmolu configuration

data FourmoluConfig = FourmoluConfig
  { FourmoluConfig -> PrinterOptsPartial
cfgFilePrinterOpts :: PrinterOptsPartial,
    FourmoluConfig -> FixityMap
cfgFileFixities :: FixityMap
  }
  deriving (FourmoluConfig -> FourmoluConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FourmoluConfig -> FourmoluConfig -> Bool
$c/= :: FourmoluConfig -> FourmoluConfig -> Bool
== :: FourmoluConfig -> FourmoluConfig -> Bool
$c== :: FourmoluConfig -> FourmoluConfig -> Bool
Eq, Int -> FourmoluConfig -> ShowS
[FourmoluConfig] -> ShowS
FourmoluConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FourmoluConfig] -> ShowS
$cshowList :: [FourmoluConfig] -> ShowS
show :: FourmoluConfig -> String
$cshow :: FourmoluConfig -> String
showsPrec :: Int -> FourmoluConfig -> ShowS
$cshowsPrec :: Int -> FourmoluConfig -> ShowS
Show)

instance Aeson.FromJSON FourmoluConfig where
  parseJSON :: Value -> Parser FourmoluConfig
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"FourmoluConfig" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    PrinterOptsPartial
cfgFilePrinterOpts <- forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
    [Text]
rawFixities <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixities" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    FixityMap
cfgFileFixities <-
      case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
parseFixityDeclaration [Text]
rawFixities of
        Right [[(OpName, FixityInfo)]]
fixities -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [[(OpName, FixityInfo)]]
fixities
        Left ParseErrorBundle Text Void
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e
    return FourmoluConfig {FixityMap
PrinterOptsPartial
cfgFileFixities :: FixityMap
cfgFilePrinterOpts :: PrinterOptsPartial
cfgFileFixities :: FixityMap
cfgFilePrinterOpts :: PrinterOptsPartial
..}

emptyConfig :: FourmoluConfig
emptyConfig :: FourmoluConfig
emptyConfig =
  FourmoluConfig
    { cfgFilePrinterOpts :: PrinterOptsPartial
cfgFilePrinterOpts = forall a. Monoid a => a
mempty,
      cfgFileFixities :: FixityMap
cfgFileFixities = forall a. Monoid a => a
mempty
    }

-- | Read options from a config file, if found.
-- Looks recursively in parent folders, then in 'XdgConfig',
-- for a file named /fourmolu.yaml/.
loadConfigFile :: FilePath -> IO ConfigFileLoadResult
loadConfigFile :: String -> IO ConfigFileLoadResult
loadConfigFile String
path = do
  String
root <- String -> IO String
makeAbsolute String
path
  String
xdg <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
""
  let dirs :: [String]
dirs = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String
xdg forall a. a -> [a] -> [a]
: forall a. (a -> a -> a) -> [a] -> [a]
scanl1 String -> ShowS
(</>) (String -> [String]
splitPath String
root)
  [String] -> String -> IO (Maybe String)
findFile [String]
dirs String
configFileName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> ConfigFileLoadResult
ConfigNotFound [String]
dirs
    Just String
file ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseException -> ConfigFileLoadResult
ConfigParseError String
file) (String -> FourmoluConfig -> ConfigFileLoadResult
ConfigLoaded String
file)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
file

-- | The result of calling 'loadConfigFile'.
data ConfigFileLoadResult
  = ConfigLoaded FilePath FourmoluConfig
  | ConfigParseError FilePath Yaml.ParseException
  | ConfigNotFound [FilePath]
  deriving (Int -> ConfigFileLoadResult -> ShowS
[ConfigFileLoadResult] -> ShowS
ConfigFileLoadResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigFileLoadResult] -> ShowS
$cshowList :: [ConfigFileLoadResult] -> ShowS
show :: ConfigFileLoadResult -> String
$cshow :: ConfigFileLoadResult -> String
showsPrec :: Int -> ConfigFileLoadResult -> ShowS
$cshowsPrec :: Int -> ConfigFileLoadResult -> ShowS
Show)

-- | Expected file name for YAML config.
configFileName :: FilePath
configFileName :: String
configFileName = String
"fourmolu.yaml"