{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
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)
data Config region = Config
{
Config region -> [DynOption]
cfgDynOptions :: ![DynOption],
Config region -> Bool
cfgUnsafe :: !Bool,
Config region -> Bool
cfgDebug :: !Bool,
Config region -> Bool
cfgCheckIdempotence :: !Bool,
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)
data RegionIndices = RegionIndices
{
RegionIndices -> Maybe Int
regionStartLine :: !(Maybe Int),
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)
data RegionDeltas = RegionDeltas
{
RegionDeltas -> Int
regionPrefixLength :: !Int,
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)
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
}
data PrinterOpts = PrinterOpts
{
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}
regionIndicesToDeltas ::
Int ->
RegionIndices ->
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
}
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)
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
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"
}
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
}
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"