{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-- | Configuration options used by the tool.
module Ormolu.Config
  ( Config (..),
    RegionIndices (..),
    RegionDeltas (..),
    defaultConfig,
    PrinterOpts (..),
    defaultPrinterOpts,
    loadConfigFile,
    regionIndicesToDeltas,
    DynOption (..),
    dynOptionToLocatedStr,
  )
where

import Control.Monad (when)
import Data.Aeson
  ( FromJSON (..),
    camelTo2,
    defaultOptions,
    fieldLabelModifier,
    genericParseJSON,
    rejectUnknownFields,
  )
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Yaml (decodeFileEither, prettyPrintParseException)
import GHC.Generics (Generic)
import qualified SrcLoc as GHC
import System.Directory
  ( XdgDirectory (XdgConfig),
    findFile,
    getCurrentDirectory,
    getXdgDirectory,
    makeAbsolute,
  )
import System.FilePath ((</>), splitPath)
import System.IO (hPutStrLn, stderr)

-- | 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 -> PrinterOpts
cfgPrinterOpts :: PrinterOpts
  }
  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 -> PrinterOpts -> 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 :: PrinterOpts
cfgPrinterOpts = PrinterOpts
defaultPrinterOpts
    }

-- | Options controlling formatting output
data PrinterOpts = PrinterOpts
  { -- | Number of spaces to use for indentation
    PrinterOpts -> Int
poIndentStep :: Int
  }
  deriving (PrinterOpts -> PrinterOpts -> Bool
(PrinterOpts -> PrinterOpts -> Bool)
-> (PrinterOpts -> PrinterOpts -> Bool) -> Eq PrinterOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrinterOpts -> PrinterOpts -> Bool
$c/= :: PrinterOpts -> PrinterOpts -> Bool
== :: PrinterOpts -> PrinterOpts -> Bool
$c== :: PrinterOpts -> PrinterOpts -> Bool
Eq, Int -> PrinterOpts -> ShowS
[PrinterOpts] -> ShowS
PrinterOpts -> String
(Int -> PrinterOpts -> ShowS)
-> (PrinterOpts -> String)
-> ([PrinterOpts] -> ShowS)
-> Show PrinterOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrinterOpts] -> ShowS
$cshowList :: [PrinterOpts] -> ShowS
show :: PrinterOpts -> String
$cshow :: PrinterOpts -> String
showsPrec :: Int -> PrinterOpts -> ShowS
$cshowsPrec :: Int -> PrinterOpts -> ShowS
Show)

defaultPrinterOpts :: PrinterOpts
defaultPrinterOpts :: PrinterOpts
defaultPrinterOpts = PrinterOpts :: Int -> PrinterOpts
PrinterOpts {poIndentStep :: Int
poIndentStep = Int
4}

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

-- | A version of 'PrinterOpts' where any field can be empty.
-- This corresponds to the information in a config file.
data PrinterOptsPartial = PrinterOptsPartial
  { PrinterOptsPartial -> Maybe Int
popIndentation :: Maybe Int
  }
  deriving (PrinterOptsPartial -> PrinterOptsPartial -> Bool
(PrinterOptsPartial -> PrinterOptsPartial -> Bool)
-> (PrinterOptsPartial -> PrinterOptsPartial -> Bool)
-> Eq PrinterOptsPartial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrinterOptsPartial -> PrinterOptsPartial -> Bool
$c/= :: PrinterOptsPartial -> PrinterOptsPartial -> Bool
== :: PrinterOptsPartial -> PrinterOptsPartial -> Bool
$c== :: PrinterOptsPartial -> PrinterOptsPartial -> Bool
Eq, Int -> PrinterOptsPartial -> ShowS
[PrinterOptsPartial] -> ShowS
PrinterOptsPartial -> String
(Int -> PrinterOptsPartial -> ShowS)
-> (PrinterOptsPartial -> String)
-> ([PrinterOptsPartial] -> ShowS)
-> Show PrinterOptsPartial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrinterOptsPartial] -> ShowS
$cshowList :: [PrinterOptsPartial] -> ShowS
show :: PrinterOptsPartial -> String
$cshow :: PrinterOptsPartial -> String
showsPrec :: Int -> PrinterOptsPartial -> ShowS
$cshowsPrec :: Int -> PrinterOptsPartial -> ShowS
Show, (forall x. PrinterOptsPartial -> Rep PrinterOptsPartial x)
-> (forall x. Rep PrinterOptsPartial x -> PrinterOptsPartial)
-> Generic PrinterOptsPartial
forall x. Rep PrinterOptsPartial x -> PrinterOptsPartial
forall x. PrinterOptsPartial -> Rep PrinterOptsPartial x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrinterOptsPartial x -> PrinterOptsPartial
$cfrom :: forall x. PrinterOptsPartial -> Rep PrinterOptsPartial x
Generic)

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
        { rejectUnknownFields :: Bool
rejectUnknownFields = Bool
True,
          fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> (String -> Maybe String) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"pop"
        }

-- | Replace fields with those from a config file, if found.
-- Looks recursively in parent folders, then in 'XdgConfig',
-- for a file matching /fourmolu.yaml/'.
loadConfigFile :: Bool -> Maybe FilePath -> PrinterOpts -> IO PrinterOpts
loadConfigFile :: Bool -> Maybe String -> PrinterOpts -> IO PrinterOpts
loadConfigFile Bool
debug Maybe String
maybePath PrinterOpts {Int
poIndentStep :: Int
poIndentStep :: PrinterOpts -> Int
..} = do
  String
root <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getCurrentDirectory String -> IO String
makeAbsolute Maybe String
maybePath
  String
xdg <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
""
  PrinterOptsPartial {Maybe Int
popIndentation :: Maybe Int
popIndentation :: PrinterOptsPartial -> Maybe Int
..} <-
    Bool -> [String] -> IO PrinterOptsPartial
optsFromFile Bool
debug ([String] -> IO PrinterOptsPartial)
-> [String] -> IO PrinterOptsPartial
forall a b. (a -> b) -> a -> b
$ [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)
  PrinterOpts -> IO PrinterOpts
forall (m :: * -> *) a. Monad m => a -> m a
return (PrinterOpts -> IO PrinterOpts) -> PrinterOpts -> IO PrinterOpts
forall a b. (a -> b) -> a -> b
$
    PrinterOpts :: Int -> PrinterOpts
PrinterOpts
      { poIndentStep :: Int
poIndentStep = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
poIndentStep Maybe Int
popIndentation
      }

-- | Search the directories, in order, for a config file.
optsFromFile :: Bool -> [FilePath] -> IO PrinterOptsPartial
optsFromFile :: Bool -> [String] -> IO PrinterOptsPartial
optsFromFile Bool
debug [String]
dirs =
  [String] -> String -> IO (Maybe String)
findFile [String]
dirs String
configFileName IO (Maybe String)
-> (Maybe String -> IO PrinterOptsPartial) -> IO PrinterOptsPartial
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> do
      String -> IO ()
printDebug (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"No " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
configFileName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" found in any of:\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
dirs)
      PrinterOptsPartial -> IO PrinterOptsPartial
forall (m :: * -> *) a. Monad m => a -> m a
return PrinterOptsPartial
def
    Just String
file -> do
      String -> IO ()
printDebug (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
""
      String -> IO (Either ParseException PrinterOptsPartial)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
file IO (Either ParseException PrinterOptsPartial)
-> (Either ParseException PrinterOptsPartial
    -> IO PrinterOptsPartial)
-> IO PrinterOptsPartial
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ParseException
e -> do
          String -> IO ()
printDebug (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseException -> String
prettyPrintParseException ParseException
e
          PrinterOptsPartial -> IO PrinterOptsPartial
forall (m :: * -> *) a. Monad m => a -> m a
return PrinterOptsPartial
def
        Right PrinterOptsPartial
x -> PrinterOptsPartial -> IO PrinterOptsPartial
forall (m :: * -> *) a. Monad m => a -> m a
return PrinterOptsPartial
x
  where
    def :: PrinterOptsPartial
def = Maybe Int -> PrinterOptsPartial
PrinterOptsPartial Maybe Int
forall a. Maybe a
Nothing
    printDebug :: String -> IO ()
printDebug = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr

configFileName :: FilePath
configFileName :: String
configFileName = String
"fourmolu.yaml"