{-# 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 (..),
    RegionIndices (..),
    RegionDeltas (..),
    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 SrcLoc as GHC
import System.Directory
  ( XdgDirectory (XdgConfig),
    findFile,
    getXdgDirectory,
    makeAbsolute,
  )
import System.FilePath (splitPath, (</>))

-- | 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,
    -- | 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)

-- | 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
-> region
-> PrinterOptsTotal
-> Config region
Config
    { cfgDynOptions :: [DynOption]
cfgDynOptions = [],
      cfgUnsafe :: Bool
cfgUnsafe = Bool
False,
      cfgDebug :: Bool
cfgDebug = Bool
False,
      cfgCheckIdempotence :: Bool
cfgCheckIdempotence = Bool
False,
      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"