{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ormolu.Config
( Config (..),
ColorMode (..),
RegionIndices (..),
RegionDeltas (..),
SourceType (..),
defaultConfig,
regionIndicesToDeltas,
DynOption (..),
dynOptionToLocatedStr,
PrinterOpts (..),
PrinterOptsPartial,
PrinterOptsTotal,
defaultPrinterOpts,
fillMissingPrinterOpts,
CommaStyle (..),
HaddockPrintStyle (..),
loadConfigFile,
configFileName,
FourmoluConfig (..),
ConfigFileLoadResult (..),
PrinterOptsFieldMeta (..),
PrinterOptsFieldType (..),
printerOptsMeta,
overFields,
overFieldsM,
)
where
import Control.Monad (forM)
import Data.Aeson ((.!=), (.:?))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Functor.Identity (Identity (..))
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.Yaml as Yaml
import GHC.Generics (Generic)
import qualified GHC.Types.SrcLoc as GHC
import Ormolu.Config.TH
import Ormolu.Config.Types
import Ormolu.Fixity (FixityMap)
import Ormolu.Fixity.Parser (parseFixityDeclaration)
import Ormolu.Terminal (ColorMode (..))
import System.Directory
( XdgDirectory (XdgConfig),
findFile,
getXdgDirectory,
makeAbsolute,
)
import System.FilePath (splitPath, (</>))
import Text.Megaparsec (errorBundlePretty)
import Text.Printf (printf)
import Text.Read (readEither)
data SourceType
=
ModuleSource
|
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)
data Config region = Config
{
Config region -> [DynOption]
cfgDynOptions :: ![DynOption],
Config region -> FixityMap
cfgFixityOverrides :: FixityMap,
Config region -> Set String
cfgDependencies :: !(Set String),
Config region -> Bool
cfgUnsafe :: !Bool,
Config region -> Bool
cfgDebug :: !Bool,
Config region -> Bool
cfgCheckIdempotence :: !Bool,
Config region -> SourceType
cfgSourceType :: !SourceType,
Config region -> ColorMode
cfgColorMode :: !ColorMode,
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)
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]
-> FixityMap
-> Set String
-> Bool
-> Bool
-> Bool
-> SourceType
-> ColorMode
-> region
-> PrinterOptsTotal
-> Config region
Config
{ cfgDynOptions :: [DynOption]
cfgDynOptions = [],
cfgFixityOverrides :: FixityMap
cfgFixityOverrides = FixityMap
forall k a. Map k a
Map.empty,
cfgDependencies :: Set String
cfgDependencies = Set String
forall a. Set a
Set.empty,
cfgUnsafe :: Bool
cfgUnsafe = Bool
False,
cfgDebug :: Bool
cfgDebug = Bool
False,
cfgCheckIdempotence :: Bool
cfgCheckIdempotence = Bool
False,
cfgSourceType :: SourceType
cfgSourceType = SourceType
ModuleSource,
cfgColorMode :: ColorMode
cfgColorMode = ColorMode
Auto,
cfgRegion :: RegionIndices
cfgRegion =
RegionIndices :: 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
}
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
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 = $(allNothing 'PrinterOpts)
instance Aeson.FromJSON PrinterOptsPartial where
parseJSON :: Value -> Parser PrinterOptsPartial
parseJSON =
String
-> (Object -> Parser PrinterOptsPartial)
-> Value
-> Parser PrinterOptsPartial
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PrinterOpts" ((Object -> Parser PrinterOptsPartial)
-> Value -> Parser PrinterOptsPartial)
-> (Object -> Parser PrinterOptsPartial)
-> Value
-> Parser PrinterOptsPartial
forall a b. (a -> b) -> a -> b
$ \Object
o ->
(forall a. PrinterOptsFieldMeta a -> Parser (Maybe a))
-> PrinterOpts PrinterOptsFieldMeta -> Parser PrinterOptsPartial
forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM (Object -> PrinterOptsFieldMeta a -> Parser (Maybe a)
forall a. Object -> PrinterOptsFieldMeta a -> Parser (Maybe a)
parseField Object
o) PrinterOpts PrinterOptsFieldMeta
printerOptsMeta
where
parseField :: Aeson.Object -> PrinterOptsFieldMeta a -> Aeson.Parser (Maybe a)
parseField :: Object -> PrinterOptsFieldMeta a -> Parser (Maybe a)
parseField Object
o PrinterOptsFieldMeta {String
metaName :: forall a. PrinterOptsFieldMeta a -> String
metaName :: String
metaName} = do
let key :: Key
key = String -> Key
forall a. IsString a => String -> a
fromString String
metaName
Maybe Value
mValue <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
key
Maybe Value -> (Value -> Parser a) -> Parser (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Value
mValue ((Value -> Parser a) -> Parser (Maybe a))
-> (Value -> Parser a) -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Value
value ->
Value -> Parser a
forall a. PrinterOptsFieldType a => Value -> Parser a
parseJSON Value
value Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
Aeson.<?> Key -> JSONPathElement
Aeson.Key Key
key
type PrinterOptsTotal = PrinterOpts Identity
deriving instance Eq PrinterOptsTotal
deriving instance Show PrinterOptsTotal
overFields :: (forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields :: (forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields forall a. f a -> g a
f = Identity (PrinterOpts g) -> PrinterOpts g
forall a. Identity a -> a
runIdentity (Identity (PrinterOpts g) -> PrinterOpts g)
-> (PrinterOpts f -> Identity (PrinterOpts g))
-> PrinterOpts f
-> PrinterOpts g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. f a -> Identity (g a))
-> PrinterOpts f -> Identity (PrinterOpts g)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM (g a -> Identity (g a)
forall a. a -> Identity a
Identity (g a -> Identity (g a)) -> (f a -> g a) -> f a -> Identity (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> g a
forall a. f a -> g a
f)
overFieldsM :: Applicative m => (forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM :: (forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM forall a. f a -> m (g a)
f $(unpackFieldsWithSuffix 'PrinterOpts "0") = do
g Int
poIndentation <- f Int -> m (g Int)
forall a. f a -> m (g a)
f f Int
poIndentation0
g CommaStyle
poCommaStyle <- f CommaStyle -> m (g CommaStyle)
forall a. f a -> m (g a)
f f CommaStyle
poCommaStyle0
g CommaStyle
poImportExportCommaStyle <- f CommaStyle -> m (g CommaStyle)
forall a. f a -> m (g a)
f f CommaStyle
poImportExportCommaStyle0
g Bool
poIndentWheres <- f Bool -> m (g Bool)
forall a. f a -> m (g a)
f f Bool
poIndentWheres0
g Bool
poRecordBraceSpace <- f Bool -> m (g Bool)
forall a. f a -> m (g a)
f f Bool
poRecordBraceSpace0
g Bool
poDiffFriendlyImportExport <- f Bool -> m (g Bool)
forall a. f a -> m (g a)
f f Bool
poDiffFriendlyImportExport0
g Bool
poRespectful <- f Bool -> m (g Bool)
forall a. f a -> m (g a)
f f Bool
poRespectful0
g HaddockPrintStyle
poHaddockStyle <- f HaddockPrintStyle -> m (g HaddockPrintStyle)
forall a. f a -> m (g a)
f f HaddockPrintStyle
poHaddockStyle0
g Int
poNewlinesBetweenDecls <- f Int -> m (g Int)
forall a. f a -> m (g a)
f f Int
poNewlinesBetweenDecls0
return PrinterOpts :: forall (f :: * -> *).
f Int
-> f CommaStyle
-> f CommaStyle
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f HaddockPrintStyle
-> f Int
-> PrinterOpts f
PrinterOpts {g Bool
g Int
g HaddockPrintStyle
g CommaStyle
poNewlinesBetweenDecls :: g Int
poHaddockStyle :: g HaddockPrintStyle
poRespectful :: g Bool
poDiffFriendlyImportExport :: g Bool
poRecordBraceSpace :: g Bool
poIndentWheres :: g Bool
poImportExportCommaStyle :: g CommaStyle
poCommaStyle :: g CommaStyle
poIndentation :: g Int
poNewlinesBetweenDecls :: g Int
poHaddockStyle :: g HaddockPrintStyle
poRespectful :: g Bool
poDiffFriendlyImportExport :: g Bool
poRecordBraceSpace :: g Bool
poIndentWheres :: g Bool
poImportExportCommaStyle :: g CommaStyle
poCommaStyle :: g CommaStyle
poIndentation :: g Int
..}
defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts = (forall a. PrinterOptsFieldMeta a -> Identity a)
-> PrinterOpts PrinterOptsFieldMeta -> PrinterOptsTotal
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a)
-> (PrinterOptsFieldMeta a -> a)
-> PrinterOptsFieldMeta a
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrinterOptsFieldMeta a -> a
forall a. PrinterOptsFieldMeta a -> a
metaDefault) PrinterOpts PrinterOptsFieldMeta
printerOptsMeta
fillMissingPrinterOpts ::
forall f.
Applicative f =>
PrinterOptsPartial ->
PrinterOpts f ->
PrinterOpts f
fillMissingPrinterOpts :: PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts PrinterOptsPartial
p1 PrinterOpts f
p2 = (forall a. PrinterOptsFieldMeta a -> f a)
-> PrinterOpts PrinterOptsFieldMeta -> PrinterOpts f
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields forall a. PrinterOptsFieldMeta a -> f a
fillField PrinterOpts PrinterOptsFieldMeta
printerOptsMeta
where
fillField :: PrinterOptsFieldMeta a -> f a
fillField :: PrinterOptsFieldMeta a -> f a
fillField PrinterOptsFieldMeta a
meta = f a -> (a -> f a) -> Maybe a -> f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOptsFieldMeta a -> PrinterOpts f -> f a
forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField PrinterOptsFieldMeta a
meta PrinterOpts f
p2) a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOptsFieldMeta a -> PrinterOptsPartial -> Maybe a
forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField PrinterOptsFieldMeta a
meta PrinterOptsPartial
p1)
data PrinterOptsFieldMeta a where
PrinterOptsFieldMeta ::
PrinterOptsFieldType a =>
{ PrinterOptsFieldMeta a -> String
metaName :: String,
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField :: forall f. PrinterOpts f -> f a,
PrinterOptsFieldMeta a -> String
metaPlaceholder :: String,
PrinterOptsFieldMeta a -> String
metaHelp :: String,
PrinterOptsFieldMeta a -> a
metaDefault :: a
} ->
PrinterOptsFieldMeta a
printerOptsMeta :: PrinterOpts PrinterOptsFieldMeta
printerOptsMeta :: PrinterOpts PrinterOptsFieldMeta
printerOptsMeta =
PrinterOpts :: forall (f :: * -> *).
f Int
-> f CommaStyle
-> f CommaStyle
-> f Bool
-> f Bool
-> f Bool
-> f Bool
-> f HaddockPrintStyle
-> f Int
-> PrinterOpts f
PrinterOpts
{ poIndentation :: PrinterOptsFieldMeta Int
poIndentation =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"indentation",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Int
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation,
metaPlaceholder :: String
metaPlaceholder = String
"WIDTH",
metaHelp :: String
metaHelp = String
"Number of spaces per indentation step",
metaDefault :: Int
metaDefault = Int
4
},
poCommaStyle :: PrinterOptsFieldMeta CommaStyle
poCommaStyle =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"comma-style",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f CommaStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle,
metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
metaHelp :: String
metaHelp =
String -> ShowS
forall r. PrintfType r => String -> r
printf
String
"How to place commas in multi-line lists, records, etc. (choices: %s)"
(BijectiveMap CommaStyle -> String
forall a. BijectiveMap a -> String
showAllValues BijectiveMap CommaStyle
commaStyleMap),
metaDefault :: CommaStyle
metaDefault = CommaStyle
Leading
},
poImportExportCommaStyle :: PrinterOptsFieldMeta CommaStyle
poImportExportCommaStyle =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"import-export-comma-style",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f CommaStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poImportExportCommaStyle,
metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
metaHelp :: String
metaHelp =
String -> ShowS
forall r. PrintfType r => String -> r
printf
String
"How to place commas in multi-line import and export lists (choices: %s)"
(BijectiveMap CommaStyle -> String
forall a. BijectiveMap a -> String
showAllValues BijectiveMap CommaStyle
commaStyleMap),
metaDefault :: CommaStyle
metaDefault = CommaStyle
Trailing
},
poIndentWheres :: PrinterOptsFieldMeta Bool
poIndentWheres =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"indent-wheres",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres,
metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
metaHelp :: String
metaHelp =
[String] -> String
unwords
[ String
"Whether to indent 'where' bindings past the preceding body",
String
"(rather than half-indenting the 'where' keyword)"
],
metaDefault :: Bool
metaDefault = Bool
False
},
poRecordBraceSpace :: PrinterOptsFieldMeta Bool
poRecordBraceSpace =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"record-brace-space",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace,
metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
metaHelp :: String
metaHelp = String
"Whether to leave a space before an opening record brace",
metaDefault :: Bool
metaDefault = Bool
False
},
poDiffFriendlyImportExport :: PrinterOptsFieldMeta Bool
poDiffFriendlyImportExport =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"diff-friendly-import-export",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poDiffFriendlyImportExport,
metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
metaHelp :: String
metaHelp =
[String] -> String
unwords
[ String
"Whether to make use of extra commas in import/export lists",
String
"(as opposed to Ormolu's style)"
],
metaDefault :: Bool
metaDefault = Bool
True
},
poRespectful :: PrinterOptsFieldMeta Bool
poRespectful =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"respectful",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Bool
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful,
metaPlaceholder :: String
metaPlaceholder = String
"BOOL",
metaHelp :: String
metaHelp = String
"Give the programmer more choice on where to insert blank lines",
metaDefault :: Bool
metaDefault = Bool
True
},
poHaddockStyle :: PrinterOptsFieldMeta HaddockPrintStyle
poHaddockStyle =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"haddock-style",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle,
metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
metaHelp :: String
metaHelp =
String -> ShowS
forall r. PrintfType r => String -> r
printf
String
"How to print Haddock comments (choices: %s)"
(BijectiveMap HaddockPrintStyle -> String
forall a. BijectiveMap a -> String
showAllValues BijectiveMap HaddockPrintStyle
haddockPrintStyleMap),
metaDefault :: HaddockPrintStyle
metaDefault = HaddockPrintStyle
HaddockMultiLine
},
poNewlinesBetweenDecls :: PrinterOptsFieldMeta Int
poNewlinesBetweenDecls =
PrinterOptsFieldMeta :: forall a.
PrinterOptsFieldType a =>
String
-> (forall (f :: * -> *). PrinterOpts f -> f a)
-> String
-> String
-> a
-> PrinterOptsFieldMeta a
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"newlines-between-decls",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f Int
metaGetField = forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls,
metaPlaceholder :: String
metaPlaceholder = String
"HEIGHT",
metaHelp :: String
metaHelp = String
"Number of spaces between top-level declarations",
metaDefault :: Int
metaDefault = Int
1
}
}
class PrinterOptsFieldType a where
parseJSON :: Aeson.Value -> Aeson.Parser a
default parseJSON :: Aeson.FromJSON a => Aeson.Value -> Aeson.Parser a
parseJSON = Value -> Parser a
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON
parseText :: String -> Either String a
default parseText :: Read a => String -> Either String a
parseText = String -> Either String a
forall a. Read a => String -> Either String a
readEither
showText :: a -> String
default showText :: Show a => a -> String
showText = a -> String
forall a. Show a => a -> String
show
instance PrinterOptsFieldType Int
instance PrinterOptsFieldType Bool where
parseText :: String -> Either String Bool
parseText = \case
String
"false" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
String
"true" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
String
unknown ->
String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool)
-> ([String] -> String) -> [String] -> Either String Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String Bool) -> [String] -> Either String Bool
forall a b. (a -> b) -> a -> b
$
[ String
"unknown value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
unknown,
String
"Valid values are: \"false\" or \"true\""
]
commaStyleMap :: BijectiveMap CommaStyle
commaStyleMap :: BijectiveMap CommaStyle
commaStyleMap =
$( mkBijectiveMap
[ ('Leading, "leading"),
('Trailing, "trailing")
]
)
haddockPrintStyleMap :: BijectiveMap HaddockPrintStyle
haddockPrintStyleMap :: BijectiveMap HaddockPrintStyle
haddockPrintStyleMap =
$( mkBijectiveMap
[ ('HaddockSingleLine, "single-line"),
('HaddockMultiLine, "multi-line")
]
)
instance PrinterOptsFieldType CommaStyle where
parseJSON :: Value -> Parser CommaStyle
parseJSON = BijectiveMap CommaStyle -> String -> Value -> Parser CommaStyle
forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap CommaStyle
commaStyleMap String
"CommaStyle"
parseText :: String -> Either String CommaStyle
parseText = BijectiveMap CommaStyle -> String -> Either String CommaStyle
forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap CommaStyle
commaStyleMap
showText :: CommaStyle -> String
showText = ShowS
forall a. Show a => a -> String
show ShowS -> (CommaStyle -> String) -> CommaStyle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BijectiveMap CommaStyle -> CommaStyle -> String
forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap CommaStyle
commaStyleMap
instance PrinterOptsFieldType HaddockPrintStyle where
parseJSON :: Value -> Parser HaddockPrintStyle
parseJSON = BijectiveMap HaddockPrintStyle
-> String -> Value -> Parser HaddockPrintStyle
forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap String
"CommaStyle"
parseText :: String -> Either String HaddockPrintStyle
parseText = BijectiveMap HaddockPrintStyle
-> String -> Either String HaddockPrintStyle
forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap
showText :: HaddockPrintStyle -> String
showText = ShowS
forall a. Show a => a -> String
show ShowS
-> (HaddockPrintStyle -> String) -> HaddockPrintStyle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BijectiveMap HaddockPrintStyle -> HaddockPrintStyle -> String
forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap
parseJSONWith :: BijectiveMap a -> String -> Aeson.Value -> Aeson.Parser a
parseJSONWith :: BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap a
mapping String
name =
String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
name (Either String a -> Parser a
forall a. Either String a -> Parser a
fromEither (Either String a -> Parser a)
-> (Text -> Either String a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BijectiveMap a -> String -> Either String a
forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap a
mapping (String -> Either String a)
-> (Text -> String) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
where
fromEither :: Either String a -> Parser a
fromEither = (String -> Parser a)
-> (a -> Parser a) -> Either String a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser a
forall a. String -> Parser a
Aeson.parseFail a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
data FourmoluConfig = FourmoluConfig
{ FourmoluConfig -> PrinterOptsPartial
cfgFilePrinterOpts :: PrinterOptsPartial,
FourmoluConfig -> FixityMap
cfgFileFixities :: FixityMap
}
deriving (FourmoluConfig -> FourmoluConfig -> Bool
(FourmoluConfig -> FourmoluConfig -> Bool)
-> (FourmoluConfig -> FourmoluConfig -> Bool) -> Eq FourmoluConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FourmoluConfig -> FourmoluConfig -> Bool
$c/= :: FourmoluConfig -> FourmoluConfig -> Bool
== :: FourmoluConfig -> FourmoluConfig -> Bool
$c== :: FourmoluConfig -> FourmoluConfig -> Bool
Eq, Int -> FourmoluConfig -> ShowS
[FourmoluConfig] -> ShowS
FourmoluConfig -> String
(Int -> FourmoluConfig -> ShowS)
-> (FourmoluConfig -> String)
-> ([FourmoluConfig] -> ShowS)
-> Show FourmoluConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FourmoluConfig] -> ShowS
$cshowList :: [FourmoluConfig] -> ShowS
show :: FourmoluConfig -> String
$cshow :: FourmoluConfig -> String
showsPrec :: Int -> FourmoluConfig -> ShowS
$cshowsPrec :: Int -> FourmoluConfig -> ShowS
Show)
instance Aeson.FromJSON FourmoluConfig where
parseJSON :: Value -> Parser FourmoluConfig
parseJSON = String
-> (Object -> Parser FourmoluConfig)
-> Value
-> Parser FourmoluConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"FourmoluConfig" ((Object -> Parser FourmoluConfig)
-> Value -> Parser FourmoluConfig)
-> (Object -> Parser FourmoluConfig)
-> Value
-> Parser FourmoluConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
PrinterOptsPartial
cfgFilePrinterOpts <- Value -> Parser PrinterOptsPartial
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
[Text]
rawFixities <- Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixities" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
FixityMap
cfgFileFixities <-
case (Text
-> Either (ParseErrorBundle Text Void) [(String, FixityInfo)])
-> [Text]
-> Either (ParseErrorBundle Text Void) [[(String, FixityInfo)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either (ParseErrorBundle Text Void) [(String, FixityInfo)]
parseFixityDeclaration [Text]
rawFixities of
Right [[(String, FixityInfo)]]
fixities -> FixityMap -> Parser FixityMap
forall (m :: * -> *) a. Monad m => a -> m a
return (FixityMap -> Parser FixityMap)
-> ([[(String, FixityInfo)]] -> FixityMap)
-> [[(String, FixityInfo)]]
-> Parser FixityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, FixityInfo)] -> FixityMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, FixityInfo)] -> FixityMap)
-> ([[(String, FixityInfo)]] -> [(String, FixityInfo)])
-> [[(String, FixityInfo)]]
-> FixityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(String, FixityInfo)]] -> [(String, FixityInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(String, FixityInfo)]] -> Parser FixityMap)
-> [[(String, FixityInfo)]] -> Parser FixityMap
forall a b. (a -> b) -> a -> b
$ [[(String, FixityInfo)]]
fixities
Left ParseErrorBundle Text Void
e -> String -> Parser FixityMap
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FixityMap) -> String -> Parser FixityMap
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e
return FourmoluConfig :: PrinterOptsPartial -> FixityMap -> FourmoluConfig
FourmoluConfig {FixityMap
PrinterOptsPartial
cfgFileFixities :: FixityMap
cfgFilePrinterOpts :: PrinterOptsPartial
cfgFileFixities :: FixityMap
cfgFilePrinterOpts :: PrinterOptsPartial
..}
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 ->
(ParseException -> ConfigFileLoadResult)
-> (FourmoluConfig -> ConfigFileLoadResult)
-> Either ParseException FourmoluConfig
-> ConfigFileLoadResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseException -> ConfigFileLoadResult
ConfigParseError String
file) (String -> FourmoluConfig -> ConfigFileLoadResult
ConfigLoaded String
file)
(Either ParseException FourmoluConfig -> ConfigFileLoadResult)
-> IO (Either ParseException FourmoluConfig)
-> IO ConfigFileLoadResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either ParseException FourmoluConfig)
forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
file
data ConfigFileLoadResult
= ConfigLoaded FilePath FourmoluConfig
| ConfigParseError FilePath Yaml.ParseException
| ConfigNotFound [FilePath]
deriving (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)
configFileName :: FilePath
configFileName :: String
configFileName = String
"fourmolu.yaml"