{-# 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 (..),
    HaddockPrintStyle (..),
    HaddockPrintStyleModule (..),
    ImportExportStyle (..),
    LetStyle (..),
    InStyle (..),

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

    -- ** Utilities
    PrinterOptsFieldMeta (..),
    PrinterOptsFieldType (..),
    printerOptsMeta,
    overFields,
    overFieldsM,
  )
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.Text as Text
import qualified Data.Yaml as Yaml
import GHC.Generics (Generic)
import qualified GHC.Types.SrcLoc as GHC
import Ormolu.Config.TH
import Ormolu.Config.Types
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)
import Text.Printf (printf)
import Text.Read (readEither)

-- | 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 -> String -> String
[SourceType] -> String -> String
SourceType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SourceType] -> String -> String
$cshowList :: [SourceType] -> String -> String
show :: SourceType -> String
$cshow :: SourceType -> String
showsPrec :: Int -> SourceType -> String -> String
$cshowsPrec :: Int -> SourceType -> String -> String
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 String
cfgDependencies :: !(Set String),
    -- | 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 -> String -> String
forall region.
Show region =>
Int -> Config region -> String -> String
forall region. Show region => [Config region] -> String -> String
forall region. Show region => Config region -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Config region] -> String -> String
$cshowList :: forall region. Show region => [Config region] -> String -> String
show :: Config region -> String
$cshow :: forall region. Show region => Config region -> String
showsPrec :: Int -> Config region -> String -> String
$cshowsPrec :: forall region.
Show region =>
Int -> Config region -> String -> String
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 -> String -> String
[RegionIndices] -> String -> String
RegionIndices -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegionIndices] -> String -> String
$cshowList :: [RegionIndices] -> String -> String
show :: RegionIndices -> String
$cshow :: RegionIndices -> String
showsPrec :: Int -> RegionIndices -> String -> String
$cshowsPrec :: Int -> RegionIndices -> String -> String
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 -> String -> String
[RegionDeltas] -> String -> String
RegionDeltas -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegionDeltas] -> String -> String
$cshowList :: [RegionDeltas] -> String -> String
show :: RegionDeltas -> String
$cshow :: RegionDeltas -> String
showsPrec :: Int -> RegionDeltas -> String -> String
$cshowsPrec :: Int -> RegionDeltas -> String -> String
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 String
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 -> String -> String
[DynOption] -> String -> String
DynOption -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DynOption] -> String -> String
$cshowList :: [DynOption] -> String -> String
show :: DynOption -> String
$cshow :: DynOption -> String
showsPrec :: Int -> DynOption -> String -> String
$cshowsPrec :: Int -> DynOption -> String -> String
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 = $(allNothing 'PrinterOpts)

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 (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM (forall a. Object -> PrinterOptsFieldMeta a -> Parser (Maybe a)
parseField Object
o) PrinterOpts PrinterOptsFieldMeta
printerOptsMeta
    where
      parseField :: Aeson.Object -> PrinterOptsFieldMeta a -> Aeson.Parser (Maybe a)
      parseField :: forall a. Object -> PrinterOptsFieldMeta a -> Parser (Maybe a)
parseField Object
o PrinterOptsFieldMeta {String
metaName :: forall a. PrinterOptsFieldMeta a -> String
metaName :: String
metaName} = do
        let key :: Key
key = forall a. IsString a => String -> a
fromString String
metaName
        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. PrinterOptsFieldType a => Value -> Parser a
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

overFields :: (forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields forall a. f a -> g a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. f a -> g a
f)

overFieldsM :: Applicative m => (forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM forall a. f a -> m (g a)
f $(unpackFieldsWithSuffix 'PrinterOpts "0") = do
  g Int
poIndentation <- forall a. f a -> m (g a)
f f Int
poIndentation0
  g FunctionArrowsStyle
poFunctionArrows <- forall a. f a -> m (g a)
f f FunctionArrowsStyle
poFunctionArrows0
  g CommaStyle
poCommaStyle <- forall a. f a -> m (g a)
f f CommaStyle
poCommaStyle0
  g ImportExportStyle
poImportExportStyle <- forall a. f a -> m (g a)
f f ImportExportStyle
poImportExportStyle0
  g Bool
poIndentWheres <- forall a. f a -> m (g a)
f f Bool
poIndentWheres0
  g Bool
poRecordBraceSpace <- forall a. f a -> m (g a)
f f Bool
poRecordBraceSpace0
  g Int
poNewlinesBetweenDecls <- forall a. f a -> m (g a)
f f Int
poNewlinesBetweenDecls0
  g HaddockPrintStyle
poHaddockStyle <- forall a. f a -> m (g a)
f f HaddockPrintStyle
poHaddockStyle0
  g HaddockPrintStyleModule
poHaddockStyleModule <- forall a. f a -> m (g a)
f f HaddockPrintStyleModule
poHaddockStyleModule0
  g LetStyle
poLetStyle <- forall a. f a -> m (g a)
f f LetStyle
poLetStyle0
  g InStyle
poInStyle <- forall a. f a -> m (g a)
f f InStyle
poInStyle0
  g Unicode
poUnicode <- forall a. f a -> m (g a)
f f Unicode
poUnicode0
  g Bool
poRespectful <- forall a. f a -> m (g a)
f f Bool
poRespectful0
  return PrinterOpts {g Bool
g Int
g Unicode
g InStyle
g LetStyle
g ImportExportStyle
g HaddockPrintStyleModule
g HaddockPrintStyle
g FunctionArrowsStyle
g CommaStyle
poRespectful :: g Bool
poUnicode :: g Unicode
poInStyle :: g InStyle
poLetStyle :: g LetStyle
poHaddockStyleModule :: g HaddockPrintStyleModule
poHaddockStyle :: g HaddockPrintStyle
poNewlinesBetweenDecls :: g Int
poRecordBraceSpace :: g Bool
poIndentWheres :: g Bool
poImportExportStyle :: g ImportExportStyle
poCommaStyle :: g CommaStyle
poFunctionArrows :: g FunctionArrowsStyle
poIndentation :: g Int
poRespectful :: g Bool
poUnicode :: g Unicode
poInStyle :: g InStyle
poLetStyle :: g LetStyle
poHaddockStyleModule :: g HaddockPrintStyleModule
poHaddockStyle :: g HaddockPrintStyle
poNewlinesBetweenDecls :: g Int
poRecordBraceSpace :: g Bool
poIndentWheres :: g Bool
poImportExportStyle :: g ImportExportStyle
poCommaStyle :: g CommaStyle
poFunctionArrows :: g FunctionArrowsStyle
poIndentation :: g Int
..}

defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts = forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrinterOptsFieldMeta a -> a
metaDefault) PrinterOpts PrinterOptsFieldMeta
printerOptsMeta

-- | Fill the field values that are 'Nothing' in the first argument
-- with the values of the corresponding fields of the second argument.
fillMissingPrinterOpts ::
  forall f.
  Applicative f =>
  PrinterOptsPartial ->
  PrinterOpts f ->
  PrinterOpts f
fillMissingPrinterOpts :: forall (f :: * -> *).
Applicative f =>
PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts PrinterOptsPartial
p1 PrinterOpts f
p2 = forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields forall a. PrinterOptsFieldMeta a -> f a
fillField PrinterOpts PrinterOptsFieldMeta
printerOptsMeta
  where
    fillField :: PrinterOptsFieldMeta a -> f a
    fillField :: forall a. PrinterOptsFieldMeta a -> f a
fillField PrinterOptsFieldMeta a
meta = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField PrinterOptsFieldMeta a
meta PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField PrinterOptsFieldMeta a
meta PrinterOptsPartial
p1)

-- | Source of truth for how PrinterOpts is parsed from configuration sources.
data PrinterOptsFieldMeta a where
  PrinterOptsFieldMeta ::
    PrinterOptsFieldType a =>
    { forall a. PrinterOptsFieldMeta a -> String
metaName :: String,
      -- In future versions of GHC, this could be replaced with a
      -- `metaProxyField = Proxy @"poIndentation"` field using `HasField`
      -- https://gitlab.haskell.org/ghc/ghc/-/issues/20989
      forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField :: forall f. PrinterOpts f -> f a,
      forall a. PrinterOptsFieldMeta a -> String
metaPlaceholder :: String,
      forall a. PrinterOptsFieldMeta a -> String
metaHelp :: String,
      forall a. PrinterOptsFieldMeta a -> a
metaDefault :: a
    } ->
    PrinterOptsFieldMeta a

printerOptsMeta :: PrinterOpts PrinterOptsFieldMeta
printerOptsMeta :: PrinterOpts PrinterOptsFieldMeta
printerOptsMeta =
  PrinterOpts
    { poIndentation :: PrinterOptsFieldMeta Int
poIndentation =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"indentation",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Int
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation,
            metaPlaceholder :: String
metaPlaceholder = String
"WIDTH",
            metaHelp :: String
metaHelp = String
"Number of spaces per indentation step",
            metaDefault :: Int
metaDefault = Int
4
          },
      poFunctionArrows :: PrinterOptsFieldMeta FunctionArrowsStyle
poFunctionArrows =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"function-arrows",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp = String
"Styling of arrows in type signatures",
            metaDefault :: FunctionArrowsStyle
metaDefault = FunctionArrowsStyle
TrailingArrows
          },
      poCommaStyle :: PrinterOptsFieldMeta CommaStyle
poCommaStyle =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"comma-style",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f CommaStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp =
              forall r. PrintfType r => String -> r
printf
                String
"How to place commas in multi-line lists, records, etc. (choices: %s)"
                (forall a. BijectiveMap a -> String
showAllValues BijectiveMap CommaStyle
commaStyleMap),
            metaDefault :: CommaStyle
metaDefault = CommaStyle
Leading
          },
      poImportExportStyle :: PrinterOptsFieldMeta ImportExportStyle
poImportExportStyle =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"import-export-style",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp =
              forall r. PrintfType r => String -> r
printf
                String
"Styling of import/export lists (choices: %s)"
                (forall a. BijectiveMap a -> String
showAllValues BijectiveMap ImportExportStyle
importExportStyleMap),
            metaDefault :: ImportExportStyle
metaDefault = ImportExportStyle
ImportExportDiffFriendly
          },
      poIndentWheres :: PrinterOptsFieldMeta Bool
poIndentWheres =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"indent-wheres",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres,
            metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
            metaHelp :: String
metaHelp =
              [String] -> String
unwords
                [ String
"Whether to indent 'where' bindings past the preceding body",
                  String
"(rather than half-indenting the 'where' keyword)"
                ],
            metaDefault :: Bool
metaDefault = Bool
False
          },
      poRecordBraceSpace :: PrinterOptsFieldMeta Bool
poRecordBraceSpace =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"record-brace-space",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace,
            metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
            metaHelp :: String
metaHelp = String
"Whether to leave a space before an opening record brace",
            metaDefault :: Bool
metaDefault = Bool
False
          },
      poNewlinesBetweenDecls :: PrinterOptsFieldMeta Int
poNewlinesBetweenDecls =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"newlines-between-decls",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Int
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls,
            metaPlaceholder :: String
metaPlaceholder = String
"HEIGHT",
            metaHelp :: String
metaHelp = String
"Number of spaces between top-level declarations",
            metaDefault :: Int
metaDefault = Int
1
          },
      poHaddockStyle :: PrinterOptsFieldMeta HaddockPrintStyle
poHaddockStyle =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"haddock-style",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp =
              forall r. PrintfType r => String -> r
printf
                String
"How to print Haddock comments (choices: %s)"
                (forall a. BijectiveMap a -> String
showAllValues BijectiveMap HaddockPrintStyle
haddockPrintStyleMap),
            metaDefault :: HaddockPrintStyle
metaDefault = HaddockPrintStyle
HaddockMultiLine
          },
      poHaddockStyleModule :: PrinterOptsFieldMeta HaddockPrintStyleModule
poHaddockStyleModule =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"haddock-style-module",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
metaGetField = forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp = String
"How to print module docstring",
            metaDefault :: HaddockPrintStyleModule
metaDefault = HaddockPrintStyleModule
PrintStyleInherit
          },
      poLetStyle :: PrinterOptsFieldMeta LetStyle
poLetStyle =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"let-style",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f LetStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp =
              forall r. PrintfType r => String -> r
printf
                String
"Styling of let blocks (choices: %s)"
                (forall a. BijectiveMap a -> String
showAllValues BijectiveMap LetStyle
letStyleMap),
            metaDefault :: LetStyle
metaDefault = LetStyle
LetAuto
          },
      poInStyle :: PrinterOptsFieldMeta InStyle
poInStyle =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"in-style",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f InStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle,
            metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
            metaHelp :: String
metaHelp = String
"How to align the 'in' keyword with respect to the 'let' keyword",
            metaDefault :: InStyle
metaDefault = InStyle
InRightAlign
          },
      poUnicode :: PrinterOptsFieldMeta Unicode
poUnicode =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"unicode",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Unicode
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode,
            metaPlaceholder :: String
metaPlaceholder = String
"UNICODE",
            metaHelp :: String
metaHelp = forall r. PrintfType r => String -> r
printf String
"Output Unicode syntax (choices: %s)" (forall a. BijectiveMap a -> String
showAllValues BijectiveMap Unicode
unicodePreferenceMap),
            metaDefault :: Unicode
metaDefault = Unicode
UnicodeNever
          },
      poRespectful :: PrinterOptsFieldMeta Bool
poRespectful =
        PrinterOptsFieldMeta
          { metaName :: String
metaName = String
"respectful",
            metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful,
            metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
            metaHelp :: String
metaHelp = String
"Give the programmer more choice on where to insert blank lines",
            metaDefault :: Bool
metaDefault = Bool
True
          }
    }

class PrinterOptsFieldType a where
  parseJSON :: Aeson.Value -> Aeson.Parser a
  default parseJSON :: Aeson.FromJSON a => Aeson.Value -> Aeson.Parser a
  parseJSON = forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

  parseText :: String -> Either String a
  default parseText :: Read a => String -> Either String a
  parseText = forall a. Read a => String -> Either String a
readEither

  showText :: a -> String
  default showText :: Show a => a -> String
  showText = forall a. Show a => a -> String
show

instance PrinterOptsFieldType Int

instance PrinterOptsFieldType Bool where
  parseText :: String -> Either String Bool
parseText = \case
    String
"false" -> forall a b. b -> Either a b
Right Bool
False
    String
"true" -> forall a b. b -> Either a b
Right Bool
True
    String
unknown ->
      forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
        [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
unknown,
          String
"Valid values are: \"false\" or \"true\""
        ]

commaStyleMap :: BijectiveMap CommaStyle
commaStyleMap :: BijectiveMap CommaStyle
commaStyleMap =
  $( mkBijectiveMap
      [ ('Leading, "leading"),
        ('Trailing, "trailing")
      ]
   )

functionArrowsStyleMap :: BijectiveMap FunctionArrowsStyle
functionArrowsStyleMap :: BijectiveMap FunctionArrowsStyle
functionArrowsStyleMap =
  $( mkBijectiveMap
      [ ('TrailingArrows, "trailing"),
        ('LeadingArrows, "leading"),
        ('LeadingArgsArrows, "leading-args")
      ]
   )

haddockPrintStyleMap :: BijectiveMap HaddockPrintStyle
haddockPrintStyleMap :: BijectiveMap HaddockPrintStyle
haddockPrintStyleMap =
  $( mkBijectiveMap
      [ ('HaddockSingleLine, "single-line"),
        ('HaddockMultiLine, "multi-line"),
        ('HaddockMultiLineCompact, "multi-line-compact")
      ]
   )

importExportStyleMap :: BijectiveMap ImportExportStyle
importExportStyleMap :: BijectiveMap ImportExportStyle
importExportStyleMap =
  $( mkBijectiveMap
      [ ('ImportExportLeading, "leading"),
        ('ImportExportTrailing, "trailing"),
        ('ImportExportDiffFriendly, "diff-friendly")
      ]
   )

letStyleMap :: BijectiveMap LetStyle
letStyleMap :: BijectiveMap LetStyle
letStyleMap =
  $( mkBijectiveMap
      [ ('LetAuto, "auto"),
        ('LetInline, "inline"),
        ('LetNewline, "newline"),
        ('LetMixed, "mixed")
      ]
   )

inStyleMap :: BijectiveMap InStyle
inStyleMap :: BijectiveMap InStyle
inStyleMap =
  $( mkBijectiveMap
      [ ('InLeftAlign, "left-align"),
        ('InRightAlign, "right-align")
      ]
   )

unicodePreferenceMap :: BijectiveMap Unicode
unicodePreferenceMap :: BijectiveMap Unicode
unicodePreferenceMap =
  $( mkBijectiveMap
      [ ('UnicodeDetect, "detect"),
        ('UnicodeAlways, "always"),
        ('UnicodeNever, "never")
      ]
   )

instance PrinterOptsFieldType CommaStyle where
  parseJSON :: Value -> Parser CommaStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap CommaStyle
commaStyleMap String
"CommaStyle"
  parseText :: String -> Either String CommaStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap CommaStyle
commaStyleMap
  showText :: CommaStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap CommaStyle
commaStyleMap

instance PrinterOptsFieldType FunctionArrowsStyle where
  parseJSON :: Value -> Parser FunctionArrowsStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap FunctionArrowsStyle
functionArrowsStyleMap String
"FunctionArrowStyle"
  parseText :: String -> Either String FunctionArrowsStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap FunctionArrowsStyle
functionArrowsStyleMap
  showText :: FunctionArrowsStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap FunctionArrowsStyle
functionArrowsStyleMap

instance PrinterOptsFieldType HaddockPrintStyle where
  parseJSON :: Value -> Parser HaddockPrintStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap String
"HaddockPrintStyle"
  parseText :: String -> Either String HaddockPrintStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap
  showText :: HaddockPrintStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap

instance PrinterOptsFieldType HaddockPrintStyleModule where
  parseJSON :: Value -> Parser HaddockPrintStyleModule
parseJSON = \case
    Value
Aeson.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
    Aeson.String Text
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
    Value
v -> HaddockPrintStyle -> HaddockPrintStyleModule
PrintStyleOverride forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrinterOptsFieldType a => Value -> Parser a
parseJSON Value
v
  parseText :: String -> Either String HaddockPrintStyleModule
parseText = \case
    String
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
    String
s -> HaddockPrintStyle -> HaddockPrintStyleModule
PrintStyleOverride forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrinterOptsFieldType a => String -> Either String a
parseText String
s
  showText :: HaddockPrintStyleModule -> String
showText = \case
    HaddockPrintStyleModule
PrintStyleInherit -> String
"same as 'haddock-style'"
    PrintStyleOverride HaddockPrintStyle
x -> forall a. PrinterOptsFieldType a => a -> String
showText HaddockPrintStyle
x

instance PrinterOptsFieldType ImportExportStyle where
  parseJSON :: Value -> Parser ImportExportStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap ImportExportStyle
importExportStyleMap String
"ImportExportStyle"
  parseText :: String -> Either String ImportExportStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap ImportExportStyle
importExportStyleMap
  showText :: ImportExportStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap ImportExportStyle
importExportStyleMap

instance PrinterOptsFieldType LetStyle where
  parseJSON :: Value -> Parser LetStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap LetStyle
letStyleMap String
"LetStyle"
  parseText :: String -> Either String LetStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap LetStyle
letStyleMap
  showText :: LetStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap LetStyle
letStyleMap

instance PrinterOptsFieldType InStyle where
  parseJSON :: Value -> Parser InStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap InStyle
inStyleMap String
"InStyle"
  parseText :: String -> Either String InStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap InStyle
inStyleMap
  showText :: InStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap InStyle
inStyleMap

instance PrinterOptsFieldType Unicode where
  parseJSON :: Value -> Parser Unicode
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap Unicode
unicodePreferenceMap String
"UnicodePreference"
  parseText :: String -> Either String Unicode
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap Unicode
unicodePreferenceMap
  showText :: Unicode -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap Unicode
unicodePreferenceMap

----------------------------------------------------------------------------
-- BijectiveMap helpers

parseJSONWith :: BijectiveMap a -> String -> Aeson.Value -> Aeson.Parser a
parseJSONWith :: forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap a
mapping String
name =
  forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
name (forall {a}. Either String a -> Parser a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap a
mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
  where
    fromEither :: Either String a -> Parser a
fromEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure

----------------------------------------------------------------------------
-- 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 -> String -> String
[FourmoluConfig] -> String -> String
FourmoluConfig -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FourmoluConfig] -> String -> String
$cshowList :: [FourmoluConfig] -> String -> String
show :: FourmoluConfig -> String
$cshow :: FourmoluConfig -> String
showsPrec :: Int -> FourmoluConfig -> String -> String
$cshowsPrec :: Int -> FourmoluConfig -> String -> String
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) [(String, FixityInfo)]
parseFixityDeclaration [Text]
rawFixities of
        Right [[(String, 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
$ [[(String, 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 -> String -> String
(</>) (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 -> String -> String
[ConfigFileLoadResult] -> String -> String
ConfigFileLoadResult -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConfigFileLoadResult] -> String -> String
$cshowList :: [ConfigFileLoadResult] -> String -> String
show :: ConfigFileLoadResult -> String
$cshow :: ConfigFileLoadResult -> String
showsPrec :: Int -> ConfigFileLoadResult -> String -> String
$cshowsPrec :: Int -> ConfigFileLoadResult -> String -> String
Show)

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