{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Configuration options used by the tool.
module Ormolu.Config
  ( Config (..),
    ColorMode (..),
    RegionIndices (..),
    RegionDeltas (..),
    SourceType (..),
    defaultConfig,
    PrinterOpts (..),
    PrinterOptsPartial,
    PrinterOptsTotal,
    defaultPrinterOpts,
    loadConfigFile,
    configFileName,
    ConfigFileLoadResult (..),
    fillMissingPrinterOpts,
    CommaStyle (..),
    HaddockPrintStyle (..),
    regionIndicesToDeltas,
    DynOption (..),
    dynOptionToLocatedStr,
  )
where

import Data.Aeson
  ( FromJSON (..),
    camelTo2,
    constructorTagModifier,
    defaultOptions,
    fieldLabelModifier,
    genericParseJSON,
  )
import qualified Data.ByteString.Lazy as BS
import Data.Char (isLower)
import Data.Functor.Identity (Identity (..))
import Data.YAML (Pos)
import Data.YAML.Aeson (decode1)
import GHC.Generics (Generic)
import qualified GHC.Types.SrcLoc as GHC
import Ormolu.Terminal (ColorMode (..))
import System.Directory
  ( XdgDirectory (XdgConfig),
    findFile,
    getXdgDirectory,
    makeAbsolute,
  )
import System.FilePath (splitPath, (</>))

-- | 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
/= :: SourceType -> SourceType -> Bool
$c/= :: SourceType -> SourceType -> Bool
== :: SourceType -> SourceType -> Bool
$c== :: 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
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
    Config region -> [DynOption]
cfgDynOptions :: ![DynOption],
    -- | Do formatting faster but without automatic detection of defects
    Config region -> Bool
cfgUnsafe :: !Bool,
    -- | Output information useful for debugging
    Config region -> Bool
cfgDebug :: !Bool,
    -- | Checks if re-formatting the result is idempotent
    Config region -> Bool
cfgCheckIdempotence :: !Bool,
    -- | How to parse the input (regular haskell module or Backpack file)
    Config region -> SourceType
cfgSourceType :: !SourceType,
    -- | Whether to use colors and other features of ANSI terminals
    Config region -> ColorMode
cfgColorMode :: !ColorMode,
    -- | Region selection
    Config region -> region
cfgRegion :: !region,
    Config region -> PrinterOptsTotal
cfgPrinterOpts :: !PrinterOptsTotal
  }
  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
/= :: 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
[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
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, a -> Config b -> Config a
(a -> b) -> Config a -> Config b
(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
<$ :: a -> Config b -> Config a
$c<$ :: forall a b. a -> Config b -> Config a
fmap :: (a -> b) -> Config a -> Config b
$cfmap :: forall a b. (a -> b) -> Config a -> Config b
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
$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
(RegionIndices -> RegionIndices -> Bool)
-> (RegionIndices -> RegionIndices -> Bool) -> Eq RegionIndices
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
(Int -> RegionIndices -> ShowS)
-> (RegionIndices -> String)
-> ([RegionIndices] -> ShowS)
-> Show RegionIndices
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
(RegionDeltas -> RegionDeltas -> Bool)
-> (RegionDeltas -> RegionDeltas -> Bool) -> Eq RegionDeltas
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
(Int -> RegionDeltas -> ShowS)
-> (RegionDeltas -> String)
-> ([RegionDeltas] -> ShowS)
-> Show RegionDeltas
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 :: forall region.
[DynOption]
-> Bool
-> Bool
-> Bool
-> SourceType
-> ColorMode
-> region
-> PrinterOptsTotal
-> Config region
Config
    { cfgDynOptions :: [DynOption]
cfgDynOptions = [],
      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 :: Maybe Int -> Maybe Int -> RegionIndices
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
    }

-- | Options controlling formatting output.
data PrinterOpts f = PrinterOpts
  { -- | Number of spaces to use for indentation
    PrinterOpts f -> f Int
poIndentation :: f Int,
    -- | Whether to place commas at start or end of lines
    PrinterOpts f -> f CommaStyle
poCommaStyle :: f CommaStyle,
    -- | Whether to indent `where` blocks
    PrinterOpts f -> f Bool
poIndentWheres :: f Bool,
    -- | Leave space before opening record brace
    PrinterOpts f -> f Bool
poRecordBraceSpace :: f Bool,
    -- | Trailing commas with parentheses on separate lines
    PrinterOpts f -> f Bool
poDiffFriendlyImportExport :: f Bool,
    -- | Be less opinionated about spaces/newlines etc.
    PrinterOpts f -> f Bool
poRespectful :: f Bool,
    -- | How to print doc comments
    PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle :: f HaddockPrintStyle,
    -- | Number of newlines between top-level decls
    PrinterOpts f -> f Int
poNewlinesBetweenDecls :: f Int
  }
  deriving ((forall x. PrinterOpts f -> Rep (PrinterOpts f) x)
-> (forall x. Rep (PrinterOpts f) x -> PrinterOpts f)
-> Generic (PrinterOpts f)
forall x. Rep (PrinterOpts f) x -> PrinterOpts f
forall x. PrinterOpts f -> Rep (PrinterOpts f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
$cto :: forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
$cfrom :: forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
Generic)

-- | 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 = Maybe Int
-> Maybe CommaStyle
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe HaddockPrintStyle
-> Maybe Int
-> PrinterOptsPartial
forall (f :: * -> *).
f Int
-> f CommaStyle
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f HaddockPrintStyle
-> f Int
-> PrinterOpts f
PrinterOpts Maybe Int
forall a. Maybe a
Nothing Maybe CommaStyle
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe HaddockPrintStyle
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

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

deriving instance Eq PrinterOptsTotal

deriving instance Show PrinterOptsTotal

defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts =
  PrinterOpts :: forall (f :: * -> *).
f Int
-> f CommaStyle
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f HaddockPrintStyle
-> f Int
-> PrinterOpts f
PrinterOpts
    { poIndentation :: Identity Int
poIndentation = Int -> Identity Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4,
      poCommaStyle :: Identity CommaStyle
poCommaStyle = CommaStyle -> Identity CommaStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommaStyle
Leading,
      poIndentWheres :: Identity Bool
poIndentWheres = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False,
      poRecordBraceSpace :: Identity Bool
poRecordBraceSpace = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False,
      poDiffFriendlyImportExport :: Identity Bool
poDiffFriendlyImportExport = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True,
      poRespectful :: Identity Bool
poRespectful = Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True,
      poHaddockStyle :: Identity HaddockPrintStyle
poHaddockStyle = HaddockPrintStyle -> Identity HaddockPrintStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyle
HaddockMultiLine,
      poNewlinesBetweenDecls :: Identity Int
poNewlinesBetweenDecls = Int -> Identity Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
    }

-- | 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 :: PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts PrinterOptsPartial
p1 PrinterOpts f
p2 =
  PrinterOpts :: forall (f :: * -> *).
f Int
-> f CommaStyle
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f HaddockPrintStyle
-> f Int
-> PrinterOpts f
PrinterOpts
    { poIndentation :: f Int
poIndentation = (forall (g :: * -> *). PrinterOpts g -> g Int) -> f Int
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g Int
poIndentation,
      poCommaStyle :: f CommaStyle
poCommaStyle = (forall (g :: * -> *). PrinterOpts g -> g CommaStyle)
-> f CommaStyle
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g CommaStyle
poCommaStyle,
      poIndentWheres :: f Bool
poIndentWheres = (forall (g :: * -> *). PrinterOpts g -> g Bool) -> f Bool
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g Bool
poIndentWheres,
      poRecordBraceSpace :: f Bool
poRecordBraceSpace = (forall (g :: * -> *). PrinterOpts g -> g Bool) -> f Bool
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g Bool
poRecordBraceSpace,
      poDiffFriendlyImportExport :: f Bool
poDiffFriendlyImportExport = (forall (g :: * -> *). PrinterOpts g -> g Bool) -> f Bool
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g Bool
poDiffFriendlyImportExport,
      poRespectful :: f Bool
poRespectful = (forall (g :: * -> *). PrinterOpts g -> g Bool) -> f Bool
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g Bool
poRespectful,
      poHaddockStyle :: f HaddockPrintStyle
poHaddockStyle = (forall (g :: * -> *). PrinterOpts g -> g HaddockPrintStyle)
-> f HaddockPrintStyle
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g HaddockPrintStyle
poHaddockStyle,
      poNewlinesBetweenDecls :: f Int
poNewlinesBetweenDecls = (forall (g :: * -> *). PrinterOpts g -> g Int) -> f Int
forall a. (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g Int
poNewlinesBetweenDecls
    }
  where
    fillField :: (forall g. PrinterOpts g -> g a) -> f a
    fillField :: (forall (g :: * -> *). PrinterOpts g -> g a) -> f a
fillField forall (g :: * -> *). PrinterOpts g -> g a
f = f a -> (a -> f a) -> Maybe a -> f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f a
forall (g :: * -> *). PrinterOpts g -> g a
f PrinterOpts f
p2) a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> f a) -> Maybe a -> f a
forall a b. (a -> b) -> a -> b
$ PrinterOptsPartial -> Maybe a
forall (g :: * -> *). PrinterOpts g -> g a
f PrinterOptsPartial
p1

data CommaStyle
  = Leading
  | Trailing
  deriving (CommaStyle -> CommaStyle -> Bool
(CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool) -> Eq CommaStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommaStyle -> CommaStyle -> Bool
$c/= :: CommaStyle -> CommaStyle -> Bool
== :: CommaStyle -> CommaStyle -> Bool
$c== :: CommaStyle -> CommaStyle -> Bool
Eq, Eq CommaStyle
Eq CommaStyle
-> (CommaStyle -> CommaStyle -> Ordering)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> CommaStyle)
-> (CommaStyle -> CommaStyle -> CommaStyle)
-> Ord CommaStyle
CommaStyle -> CommaStyle -> Bool
CommaStyle -> CommaStyle -> Ordering
CommaStyle -> CommaStyle -> CommaStyle
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 :: CommaStyle -> CommaStyle -> CommaStyle
$cmin :: CommaStyle -> CommaStyle -> CommaStyle
max :: CommaStyle -> CommaStyle -> CommaStyle
$cmax :: CommaStyle -> CommaStyle -> CommaStyle
>= :: CommaStyle -> CommaStyle -> Bool
$c>= :: CommaStyle -> CommaStyle -> Bool
> :: CommaStyle -> CommaStyle -> Bool
$c> :: CommaStyle -> CommaStyle -> Bool
<= :: CommaStyle -> CommaStyle -> Bool
$c<= :: CommaStyle -> CommaStyle -> Bool
< :: CommaStyle -> CommaStyle -> Bool
$c< :: CommaStyle -> CommaStyle -> Bool
compare :: CommaStyle -> CommaStyle -> Ordering
$ccompare :: CommaStyle -> CommaStyle -> Ordering
$cp1Ord :: Eq CommaStyle
Ord, Int -> CommaStyle -> ShowS
[CommaStyle] -> ShowS
CommaStyle -> String
(Int -> CommaStyle -> ShowS)
-> (CommaStyle -> String)
-> ([CommaStyle] -> ShowS)
-> Show CommaStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommaStyle] -> ShowS
$cshowList :: [CommaStyle] -> ShowS
show :: CommaStyle -> String
$cshow :: CommaStyle -> String
showsPrec :: Int -> CommaStyle -> ShowS
$cshowsPrec :: Int -> CommaStyle -> ShowS
Show, (forall x. CommaStyle -> Rep CommaStyle x)
-> (forall x. Rep CommaStyle x -> CommaStyle) -> Generic CommaStyle
forall x. Rep CommaStyle x -> CommaStyle
forall x. CommaStyle -> Rep CommaStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommaStyle x -> CommaStyle
$cfrom :: forall x. CommaStyle -> Rep CommaStyle x
Generic, CommaStyle
CommaStyle -> CommaStyle -> Bounded CommaStyle
forall a. a -> a -> Bounded a
maxBound :: CommaStyle
$cmaxBound :: CommaStyle
minBound :: CommaStyle
$cminBound :: CommaStyle
Bounded, Int -> CommaStyle
CommaStyle -> Int
CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle
CommaStyle -> CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
(CommaStyle -> CommaStyle)
-> (CommaStyle -> CommaStyle)
-> (Int -> CommaStyle)
-> (CommaStyle -> Int)
-> (CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle])
-> Enum CommaStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
enumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFrom :: CommaStyle -> [CommaStyle]
$cenumFrom :: CommaStyle -> [CommaStyle]
fromEnum :: CommaStyle -> Int
$cfromEnum :: CommaStyle -> Int
toEnum :: Int -> CommaStyle
$ctoEnum :: Int -> CommaStyle
pred :: CommaStyle -> CommaStyle
$cpred :: CommaStyle -> CommaStyle
succ :: CommaStyle -> CommaStyle
$csucc :: CommaStyle -> CommaStyle
Enum)

instance FromJSON CommaStyle where
  parseJSON :: Value -> Parser CommaStyle
parseJSON =
    Options -> Value -> Parser CommaStyle
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'-'
        }

data HaddockPrintStyle
  = HaddockSingleLine
  | HaddockMultiLine
  deriving (HaddockPrintStyle -> HaddockPrintStyle -> Bool
(HaddockPrintStyle -> HaddockPrintStyle -> Bool)
-> (HaddockPrintStyle -> HaddockPrintStyle -> Bool)
-> Eq HaddockPrintStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c/= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
== :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c== :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
Eq, Eq HaddockPrintStyle
Eq HaddockPrintStyle
-> (HaddockPrintStyle -> HaddockPrintStyle -> Ordering)
-> (HaddockPrintStyle -> HaddockPrintStyle -> Bool)
-> (HaddockPrintStyle -> HaddockPrintStyle -> Bool)
-> (HaddockPrintStyle -> HaddockPrintStyle -> Bool)
-> (HaddockPrintStyle -> HaddockPrintStyle -> Bool)
-> (HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle)
-> (HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle)
-> Ord HaddockPrintStyle
HaddockPrintStyle -> HaddockPrintStyle -> Bool
HaddockPrintStyle -> HaddockPrintStyle -> Ordering
HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle
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 :: HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle
$cmin :: HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle
max :: HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle
$cmax :: HaddockPrintStyle -> HaddockPrintStyle -> HaddockPrintStyle
>= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c>= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
> :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c> :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
<= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c<= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
< :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c< :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
compare :: HaddockPrintStyle -> HaddockPrintStyle -> Ordering
$ccompare :: HaddockPrintStyle -> HaddockPrintStyle -> Ordering
$cp1Ord :: Eq HaddockPrintStyle
Ord, Int -> HaddockPrintStyle -> ShowS
[HaddockPrintStyle] -> ShowS
HaddockPrintStyle -> String
(Int -> HaddockPrintStyle -> ShowS)
-> (HaddockPrintStyle -> String)
-> ([HaddockPrintStyle] -> ShowS)
-> Show HaddockPrintStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaddockPrintStyle] -> ShowS
$cshowList :: [HaddockPrintStyle] -> ShowS
show :: HaddockPrintStyle -> String
$cshow :: HaddockPrintStyle -> String
showsPrec :: Int -> HaddockPrintStyle -> ShowS
$cshowsPrec :: Int -> HaddockPrintStyle -> ShowS
Show, (forall x. HaddockPrintStyle -> Rep HaddockPrintStyle x)
-> (forall x. Rep HaddockPrintStyle x -> HaddockPrintStyle)
-> Generic HaddockPrintStyle
forall x. Rep HaddockPrintStyle x -> HaddockPrintStyle
forall x. HaddockPrintStyle -> Rep HaddockPrintStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HaddockPrintStyle x -> HaddockPrintStyle
$cfrom :: forall x. HaddockPrintStyle -> Rep HaddockPrintStyle x
Generic, HaddockPrintStyle
HaddockPrintStyle -> HaddockPrintStyle -> Bounded HaddockPrintStyle
forall a. a -> a -> Bounded a
maxBound :: HaddockPrintStyle
$cmaxBound :: HaddockPrintStyle
minBound :: HaddockPrintStyle
$cminBound :: HaddockPrintStyle
Bounded, Int -> HaddockPrintStyle
HaddockPrintStyle -> Int
HaddockPrintStyle -> [HaddockPrintStyle]
HaddockPrintStyle -> HaddockPrintStyle
HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
(HaddockPrintStyle -> HaddockPrintStyle)
-> (HaddockPrintStyle -> HaddockPrintStyle)
-> (Int -> HaddockPrintStyle)
-> (HaddockPrintStyle -> Int)
-> (HaddockPrintStyle -> [HaddockPrintStyle])
-> (HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle])
-> (HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle])
-> (HaddockPrintStyle
    -> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle])
-> Enum HaddockPrintStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromThenTo :: HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFromTo :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromTo :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFromThen :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromThen :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFrom :: HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFrom :: HaddockPrintStyle -> [HaddockPrintStyle]
fromEnum :: HaddockPrintStyle -> Int
$cfromEnum :: HaddockPrintStyle -> Int
toEnum :: Int -> HaddockPrintStyle
$ctoEnum :: Int -> HaddockPrintStyle
pred :: HaddockPrintStyle -> HaddockPrintStyle
$cpred :: HaddockPrintStyle -> HaddockPrintStyle
succ :: HaddockPrintStyle -> HaddockPrintStyle
$csucc :: HaddockPrintStyle -> HaddockPrintStyle
Enum)

instance FromJSON HaddockPrintStyle where
  parseJSON :: Value -> Parser HaddockPrintStyle
parseJSON =
    Options -> Value -> Parser HaddockPrintStyle
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"haddock-") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
camelTo2 Char
'-'
        }

-- | 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 :: Int -> Int -> RegionDeltas
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 Int -> Int -> Int
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
(DynOption -> DynOption -> Bool)
-> (DynOption -> DynOption -> Bool) -> Eq DynOption
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
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
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
$cp1Ord :: Eq 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
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) = SrcSpan -> String -> Located String
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
GHC.noSrcSpan String
o

instance FromJSON PrinterOptsPartial where
  parseJSON :: Value -> Parser PrinterOptsPartial
parseJSON =
    Options -> Value -> Parser PrinterOptsPartial
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isLower
        }

-- | 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 = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
xdg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> ShowS) -> [String] -> [String]
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 IO (Maybe String)
-> (Maybe String -> IO ConfigFileLoadResult)
-> IO ConfigFileLoadResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> ConfigFileLoadResult -> IO ConfigFileLoadResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigFileLoadResult -> IO ConfigFileLoadResult)
-> ConfigFileLoadResult -> IO ConfigFileLoadResult
forall a b. (a -> b) -> a -> b
$ [String] -> ConfigFileLoadResult
ConfigNotFound [String]
dirs
    Just String
file ->
      ((Pos, String) -> ConfigFileLoadResult)
-> (PrinterOptsPartial -> ConfigFileLoadResult)
-> Either (Pos, String) PrinterOptsPartial
-> ConfigFileLoadResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> (Pos, String) -> ConfigFileLoadResult
ConfigParseError String
file) (String -> PrinterOptsPartial -> ConfigFileLoadResult
ConfigLoaded String
file)
        (Either (Pos, String) PrinterOptsPartial -> ConfigFileLoadResult)
-> (ByteString -> Either (Pos, String) PrinterOptsPartial)
-> ByteString
-> ConfigFileLoadResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (Pos, String) PrinterOptsPartial
forall v. FromJSON v => ByteString -> Either (Pos, String) v
decode1
        (ByteString -> ConfigFileLoadResult)
-> IO ByteString -> IO ConfigFileLoadResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file

-- | The result of calling 'loadConfigFile'.
data ConfigFileLoadResult
  = ConfigLoaded FilePath PrinterOptsPartial
  | ConfigParseError FilePath (Pos, String)
  | ConfigNotFound [FilePath]
  deriving (ConfigFileLoadResult -> ConfigFileLoadResult -> Bool
(ConfigFileLoadResult -> ConfigFileLoadResult -> Bool)
-> (ConfigFileLoadResult -> ConfigFileLoadResult -> Bool)
-> Eq ConfigFileLoadResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigFileLoadResult -> ConfigFileLoadResult -> Bool
$c/= :: ConfigFileLoadResult -> ConfigFileLoadResult -> Bool
== :: ConfigFileLoadResult -> ConfigFileLoadResult -> Bool
$c== :: ConfigFileLoadResult -> ConfigFileLoadResult -> Bool
Eq, Int -> ConfigFileLoadResult -> ShowS
[ConfigFileLoadResult] -> ShowS
ConfigFileLoadResult -> String
(Int -> ConfigFileLoadResult -> ShowS)
-> (ConfigFileLoadResult -> String)
-> ([ConfigFileLoadResult] -> ShowS)
-> Show ConfigFileLoadResult
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"