{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# 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,
    overapproximatedDependencies,
    regionIndicesToDeltas,
    DynOption (..),
    dynOptionToLocatedStr,

    -- * Fourmolu configuration
    PrinterOpts (..),
    PrinterOptsPartial,
    PrinterOptsTotal,
    defaultPrinterOpts,
    defaultPrinterOptsYaml,
    fillMissingPrinterOpts,
    resolvePrinterOpts,
    CommaStyle (..),
    FunctionArrowsStyle (..),
    HaddockPrintStyle (..),
    HaddockPrintStyleModule (..),
    HaddockLocSignature (..),
    ImportExportStyle (..),
    ImportGrouping (..),
    ImportGroup (..),
    ImportGroupRule (..),
    ImportModuleMatcher (..),
    ImportRulePriority (..),
    matchAllRulePriority,
    matchLocalRulePriority,
    defaultImportRulePriority,
    QualifiedImportMatcher (..),
    LetStyle (..),
    InStyle (..),
    IfStyle (..),
    Unicode (..),
    ColumnLimit (..),
    SingleDerivingParens (..),
    parsePrinterOptsCLI,
    parsePrinterOptType,
    renderPrinterOpt,

    -- ** Loading Fourmolu configuration
    ConfigNotFound (..),
    findConfigFile,
    configFileName,
    FourmoluConfig (..),
    emptyConfig,
  )
where

import Control.Monad (forM)
import Data.Aeson ((.!=), (.:?))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Functor.Identity (Identity (..))
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (fromString)
import Distribution.ModuleName (ModuleName)
import Distribution.Types.PackageName (PackageName)
import GHC.Generics (Generic)
import GHC.Types.SrcLoc qualified as GHC
import Ormolu.Config.Gen
import Ormolu.Config.Types
import Ormolu.Fixity
import Ormolu.Terminal (ColorMode (..))
import Ormolu.Utils.Fixity (parseFixityDeclarationStr, parseModuleReexportDeclarationStr)
import System.Directory
  ( XdgDirectory (XdgConfig),
    findFile,
    getXdgDirectory,
    makeAbsolute,
  )
import System.FilePath (takeDirectory)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif

-- | 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
(SourceType -> SourceType -> Bool)
-> (SourceType -> SourceType -> Bool) -> Eq SourceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceType -> SourceType -> Bool
== :: SourceType -> SourceType -> Bool
$c/= :: SourceType -> SourceType -> Bool
/= :: SourceType -> SourceType -> Bool
Eq, Int -> SourceType -> ShowS
[SourceType] -> ShowS
SourceType -> String
(Int -> SourceType -> ShowS)
-> (SourceType -> String)
-> ([SourceType] -> ShowS)
-> Show SourceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceType -> ShowS
showsPrec :: Int -> SourceType -> ShowS
$cshow :: SourceType -> String
show :: SourceType -> String
$cshowList :: [SourceType] -> ShowS
showList :: [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 -> FixityOverrides
cfgFixityOverrides :: !FixityOverrides,
    -- | Module reexports to take into account when doing fixity resolution
    forall region. Config region -> ModuleReexports
cfgModuleReexports :: !ModuleReexports,
    -- | 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,
    forall region. Config region -> Set ModuleName
cfgLocalModules :: !(Set ModuleName)
  }
  deriving (Config region -> Config region -> Bool
(Config region -> Config region -> Bool)
-> (Config region -> Config region -> Bool) -> Eq (Config region)
forall region. Eq region => Config region -> Config region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Config region -> Config region -> Bool
Eq, Int -> Config region -> ShowS
[Config region] -> ShowS
Config region -> String
(Int -> Config region -> ShowS)
-> (Config region -> String)
-> ([Config region] -> ShowS)
-> Show (Config region)
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
$cshowsPrec :: forall region. Show region => Int -> Config region -> ShowS
showsPrec :: Int -> Config region -> ShowS
$cshow :: forall region. Show region => Config region -> String
show :: Config region -> String
$cshowList :: forall region. Show region => [Config region] -> ShowS
showList :: [Config region] -> ShowS
Show, (forall a b. (a -> b) -> Config a -> Config b)
-> (forall a b. a -> Config b -> Config a) -> Functor Config
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
$cfmap :: forall a b. (a -> b) -> Config a -> Config b
fmap :: forall a b. (a -> b) -> Config a -> Config b
$c<$ :: forall a b. a -> Config b -> Config a
<$ :: forall a b. a -> Config b -> Config a
Functor, (forall x. Config region -> Rep (Config region) x)
-> (forall x. Rep (Config region) x -> Config region)
-> Generic (Config region)
forall x. Rep (Config region) x -> Config region
forall x. Config region -> Rep (Config region) x
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
$cfrom :: forall region x. Config region -> Rep (Config region) x
from :: forall x. Config region -> Rep (Config region) x
$cto :: forall region x. Rep (Config region) x -> Config region
to :: forall x. Rep (Config region) x -> Config region
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
(RegionIndices -> RegionIndices -> Bool)
-> (RegionIndices -> RegionIndices -> Bool) -> Eq RegionIndices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionIndices -> RegionIndices -> Bool
== :: RegionIndices -> RegionIndices -> Bool
$c/= :: RegionIndices -> RegionIndices -> Bool
/= :: RegionIndices -> RegionIndices -> Bool
Eq, Int -> RegionIndices -> ShowS
[RegionIndices] -> ShowS
RegionIndices -> String
(Int -> RegionIndices -> ShowS)
-> (RegionIndices -> String)
-> ([RegionIndices] -> ShowS)
-> Show RegionIndices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionIndices -> ShowS
showsPrec :: Int -> RegionIndices -> ShowS
$cshow :: RegionIndices -> String
show :: RegionIndices -> String
$cshowList :: [RegionIndices] -> ShowS
showList :: [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
(RegionDeltas -> RegionDeltas -> Bool)
-> (RegionDeltas -> RegionDeltas -> Bool) -> Eq RegionDeltas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionDeltas -> RegionDeltas -> Bool
== :: RegionDeltas -> RegionDeltas -> Bool
$c/= :: RegionDeltas -> RegionDeltas -> Bool
/= :: RegionDeltas -> RegionDeltas -> Bool
Eq, Int -> RegionDeltas -> ShowS
[RegionDeltas] -> ShowS
RegionDeltas -> String
(Int -> RegionDeltas -> ShowS)
-> (RegionDeltas -> String)
-> ([RegionDeltas] -> ShowS)
-> Show RegionDeltas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionDeltas -> ShowS
showsPrec :: Int -> RegionDeltas -> ShowS
$cshow :: RegionDeltas -> String
show :: RegionDeltas -> String
$cshowList :: [RegionDeltas] -> ShowS
showList :: [RegionDeltas] -> ShowS
Show)

-- | Default @'Config' 'RegionIndices'@.
defaultConfig :: Config RegionIndices
defaultConfig :: Config RegionIndices
defaultConfig =
  Config
    { cfgDynOptions :: [DynOption]
cfgDynOptions = [],
      cfgFixityOverrides :: FixityOverrides
cfgFixityOverrides = FixityOverrides
defaultFixityOverrides,
      cfgModuleReexports :: ModuleReexports
cfgModuleReexports = ModuleReexports
defaultModuleReexports,
      cfgDependencies :: Set PackageName
cfgDependencies = Set PackageName
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 = Maybe Int
forall a. Maybe a
Nothing,
            regionEndLine :: Maybe Int
regionEndLine = Maybe Int
forall a. Maybe a
Nothing
          },
      cfgPrinterOpts :: PrinterOptsTotal
cfgPrinterOpts = PrinterOptsTotal
defaultPrinterOpts,
      cfgLocalModules :: Set ModuleName
cfgLocalModules = Set ModuleName
forall a. Set a
Set.empty
    }

-- | Return all dependencies of the module. This includes both the declared
-- dependencies of the component we are working with and all potential
-- module re-export targets.
overapproximatedDependencies :: Config region -> Set PackageName
overapproximatedDependencies :: forall region. Config region -> Set PackageName
overapproximatedDependencies Config {region
Bool
[DynOption]
Set PackageName
Set ModuleName
ColorMode
ModuleReexports
FixityOverrides
PrinterOptsTotal
SourceType
cfgDynOptions :: forall region. Config region -> [DynOption]
cfgFixityOverrides :: forall region. Config region -> FixityOverrides
cfgModuleReexports :: forall region. Config region -> ModuleReexports
cfgDependencies :: forall region. Config region -> Set PackageName
cfgUnsafe :: forall region. Config region -> Bool
cfgDebug :: forall region. Config region -> Bool
cfgCheckIdempotence :: forall region. Config region -> Bool
cfgSourceType :: forall region. Config region -> SourceType
cfgColorMode :: forall region. Config region -> ColorMode
cfgRegion :: forall region. Config region -> region
cfgPrinterOpts :: forall region. Config region -> PrinterOptsTotal
cfgLocalModules :: forall region. Config region -> Set ModuleName
cfgDynOptions :: [DynOption]
cfgFixityOverrides :: FixityOverrides
cfgModuleReexports :: ModuleReexports
cfgDependencies :: Set PackageName
cfgUnsafe :: Bool
cfgDebug :: Bool
cfgCheckIdempotence :: Bool
cfgSourceType :: SourceType
cfgColorMode :: ColorMode
cfgRegion :: region
cfgPrinterOpts :: PrinterOptsTotal
cfgLocalModules :: Set ModuleName
..} =
  Set PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set PackageName
cfgDependencies Set PackageName
potentialReexportTargets
  where
    potentialReexportTargets :: Set PackageName
potentialReexportTargets =
      [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
Set.fromList
        ([PackageName] -> Set PackageName)
-> ([NonEmpty (Maybe PackageName, ModuleName)] -> [PackageName])
-> [NonEmpty (Maybe PackageName, ModuleName)]
-> Set PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Maybe PackageName, ModuleName) -> [PackageName])
-> [NonEmpty (Maybe PackageName, ModuleName)] -> [PackageName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (Maybe PackageName, ModuleName) -> [PackageName]
forall {b} {b}. NonEmpty (Maybe b, b) -> [b]
toTargetPackages
        ([NonEmpty (Maybe PackageName, ModuleName)] -> Set PackageName)
-> [NonEmpty (Maybe PackageName, ModuleName)] -> Set PackageName
forall a b. (a -> b) -> a -> b
$ Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> [NonEmpty (Maybe PackageName, ModuleName)]
forall k a. Map k a -> [a]
Map.elems (ModuleReexports
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
unModuleReexports ModuleReexports
cfgModuleReexports)
    toTargetPackages :: NonEmpty (Maybe b, b) -> [b]
toTargetPackages = ((Maybe b, b) -> [b]) -> NonEmpty (Maybe b, b) -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Maybe b, b) -> [b]) -> NonEmpty (Maybe b, b) -> [b])
-> ((Maybe b, b) -> [b]) -> NonEmpty (Maybe b, b) -> [b]
forall a b. (a -> b) -> a -> b
$ \case
      (Maybe b
Nothing, b
_) -> []
      (Just b
x, b
_) -> [b
x]

-- | 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
regionStartLine :: RegionIndices -> Maybe Int
regionEndLine :: RegionIndices -> Maybe Int
regionStartLine :: Maybe Int
regionEndLine :: Maybe Int
..} =
  RegionDeltas
    { regionPrefixLength :: Int
regionPrefixLength = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) Maybe Int
regionStartLine,
      regionSuffixLength :: Int
regionSuffixLength = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
total -) Maybe Int
regionEndLine
    }

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

-- | Convert 'DynOption' to @'GHC.Located' 'String'@.
dynOptionToLocatedStr :: DynOption -> GHC.Located String
dynOptionToLocatedStr :: DynOption -> Located String
dynOptionToLocatedStr (DynOption String
o) = SrcSpan -> String -> Located String
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
(<>) = 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 =
    String
-> (Object -> Parser PrinterOptsPartial)
-> Value
-> Parser PrinterOptsPartial
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PrinterOpts" ((Object -> Parser PrinterOptsPartial)
 -> Value -> Parser PrinterOptsPartial)
-> (Object -> Parser PrinterOptsPartial)
-> Value
-> Parser PrinterOptsPartial
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      (forall a. PrinterOptsFieldType a => String -> Parser (Maybe a))
-> Parser PrinterOptsPartial
forall (f :: * -> *).
Applicative f =>
(forall a. PrinterOptsFieldType a => String -> f (Maybe a))
-> f PrinterOptsPartial
parsePrinterOptsJSON (Object -> String -> Parser (Maybe a)
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 = String -> Key
forall a. IsString a => String -> a
fromString String
keyName
        Maybe Value
mValue <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
key
        Maybe Value -> (Value -> Parser a) -> Parser (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Value
mValue ((Value -> Parser a) -> Parser (Maybe a))
-> (Value -> Parser a) -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Value
value ->
          Value -> Parser a
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
value Parser a -> JSONPathElement -> Parser a
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

-- | Apply the given configuration in order (later options override earlier).
resolvePrinterOpts :: [PrinterOptsPartial] -> PrinterOptsTotal
resolvePrinterOpts :: [PrinterOptsPartial] -> PrinterOptsTotal
resolvePrinterOpts = (PrinterOptsTotal -> PrinterOptsPartial -> PrinterOptsTotal)
-> PrinterOptsTotal -> [PrinterOptsPartial] -> PrinterOptsTotal
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((PrinterOptsPartial -> PrinterOptsTotal -> PrinterOptsTotal)
-> PrinterOptsTotal -> PrinterOptsPartial -> PrinterOptsTotal
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrinterOptsPartial -> PrinterOptsTotal -> PrinterOptsTotal
forall (f :: * -> *).
Applicative f =>
PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts) PrinterOptsTotal
defaultPrinterOpts

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

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

instance Aeson.FromJSON FourmoluConfig where
  parseJSON :: Value -> Parser FourmoluConfig
parseJSON = String
-> (Object -> Parser FourmoluConfig)
-> Value
-> Parser FourmoluConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"FourmoluConfig" ((Object -> Parser FourmoluConfig)
 -> Value -> Parser FourmoluConfig)
-> (Object -> Parser FourmoluConfig)
-> Value
-> Parser FourmoluConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    PrinterOptsPartial
cfgFilePrinterOpts <- Value -> Parser PrinterOptsPartial
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
    [String]
rawFixities <- Object
o Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixities" Parser (Maybe [String]) -> [String] -> Parser [String]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    FixityOverrides
cfgFileFixities <-
      case (String -> Either String [(OpName, FixityInfo)])
-> [String] -> Either String [[(OpName, FixityInfo)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> Either String [(OpName, FixityInfo)]
parseFixityDeclarationStr [String]
rawFixities of
        Right [[(OpName, FixityInfo)]]
fixities -> FixityOverrides -> Parser FixityOverrides
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (FixityOverrides -> Parser FixityOverrides)
-> ([[(OpName, FixityInfo)]] -> FixityOverrides)
-> [[(OpName, FixityInfo)]]
-> Parser FixityOverrides
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map OpName FixityInfo -> FixityOverrides
FixityOverrides (Map OpName FixityInfo -> FixityOverrides)
-> ([[(OpName, FixityInfo)]] -> Map OpName FixityInfo)
-> [[(OpName, FixityInfo)]]
-> FixityOverrides
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(OpName, FixityInfo)] -> Map OpName FixityInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(OpName, FixityInfo)] -> Map OpName FixityInfo)
-> ([[(OpName, FixityInfo)]] -> [(OpName, FixityInfo)])
-> [[(OpName, FixityInfo)]]
-> Map OpName FixityInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(OpName, FixityInfo)]] -> [(OpName, FixityInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(OpName, FixityInfo)]] -> Parser FixityOverrides)
-> [[(OpName, FixityInfo)]] -> Parser FixityOverrides
forall a b. (a -> b) -> a -> b
$ [[(OpName, FixityInfo)]]
fixities
        Left String
e -> String -> Parser FixityOverrides
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    [String]
rawReexports <- Object
o Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reexports" Parser (Maybe [String]) -> [String] -> Parser [String]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    ModuleReexports
cfgFileReexports <-
      case (String
 -> Either
      String (ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
-> [String]
-> Either
     String [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String
-> Either
     String (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
parseModuleReexportDeclarationStr [String]
rawReexports of
        Right [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
reexports -> ModuleReexports -> Parser ModuleReexports
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleReexports -> Parser ModuleReexports)
-> ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
    -> ModuleReexports)
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Parser ModuleReexports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> ModuleReexports
ModuleReexports (Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
 -> ModuleReexports)
-> ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
    -> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName)))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ModuleReexports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Maybe PackageName, ModuleName)
 -> NonEmpty (Maybe PackageName, ModuleName)
 -> NonEmpty (Maybe PackageName, ModuleName))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
forall a. Semigroup a => a -> a -> a
(<>) ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
 -> Parser ModuleReexports)
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Parser ModuleReexports
forall a b. (a -> b) -> a -> b
$ [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
reexports
        Left String
e -> String -> Parser ModuleReexports
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    return FourmoluConfig {ModuleReexports
FixityOverrides
PrinterOptsPartial
cfgFilePrinterOpts :: PrinterOptsPartial
cfgFileFixities :: FixityOverrides
cfgFileReexports :: ModuleReexports
cfgFilePrinterOpts :: PrinterOptsPartial
cfgFileFixities :: FixityOverrides
cfgFileReexports :: ModuleReexports
..}

emptyConfig :: FourmoluConfig
emptyConfig :: FourmoluConfig
emptyConfig =
  FourmoluConfig
    { cfgFilePrinterOpts :: PrinterOptsPartial
cfgFilePrinterOpts = PrinterOptsPartial
forall a. Monoid a => a
mempty,
      cfgFileFixities :: FixityOverrides
cfgFileFixities = Map OpName FixityInfo -> FixityOverrides
FixityOverrides Map OpName FixityInfo
forall a. Monoid a => a
mempty,
      cfgFileReexports :: ModuleReexports
cfgFileReexports = Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> ModuleReexports
ModuleReexports Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
forall a. Monoid a => a
mempty
    }

-- | Find a fourmolu configuration file.
--
-- Looks for a file named /fourmolu.yaml/, first in the given path and
-- its parents, and then in the XDG config directory.
findConfigFile :: FilePath -> IO (Either ConfigNotFound FilePath)
findConfigFile :: String -> IO (Either ConfigNotFound String)
findConfigFile String
rootDir = do
  String
rootDirAbs <- String -> IO String
makeAbsolute String
rootDir
  String
xdg <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
""
  let dirs :: [String]
dirs = String -> [String]
getParents String
rootDirAbs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
xdg]
  Either ConfigNotFound String
-> (String -> Either ConfigNotFound String)
-> Maybe String
-> Either ConfigNotFound String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConfigNotFound -> Either ConfigNotFound String
forall a b. a -> Either a b
Left (ConfigNotFound -> Either ConfigNotFound String)
-> ConfigNotFound -> Either ConfigNotFound String
forall a b. (a -> b) -> a -> b
$ [String] -> ConfigNotFound
ConfigNotFound [String]
dirs) String -> Either ConfigNotFound String
forall a b. b -> Either a b
Right (Maybe String -> Either ConfigNotFound String)
-> IO (Maybe String) -> IO (Either ConfigNotFound String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> IO (Maybe String)
findFile [String]
dirs String
configFileName
  where
    -- getParents "/a/b/c/" == ["/a/b/c/", "/a/b/", "/a/", "/"]
    getParents :: String -> [String]
getParents String
dir =
      let parentDir :: String
parentDir = ShowS
takeDirectory String
dir
       in String
dir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: if String
parentDir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dir then [] else String -> [String]
getParents String
parentDir

data ConfigNotFound = ConfigNotFound
  { ConfigNotFound -> [String]
searchDirs :: [FilePath]
  }
  deriving (Int -> ConfigNotFound -> ShowS
[ConfigNotFound] -> ShowS
ConfigNotFound -> String
(Int -> ConfigNotFound -> ShowS)
-> (ConfigNotFound -> String)
-> ([ConfigNotFound] -> ShowS)
-> Show ConfigNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigNotFound -> ShowS
showsPrec :: Int -> ConfigNotFound -> ShowS
$cshow :: ConfigNotFound -> String
show :: ConfigNotFound -> String
$cshowList :: [ConfigNotFound] -> ShowS
showList :: [ConfigNotFound] -> ShowS
Show)

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