{-# 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 (..),
ImportExportStyle (..),
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
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 -> String -> String
[SourceType] -> String -> String
SourceType -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SourceType] -> String -> String
$cshowList :: [SourceType] -> String -> String
show :: SourceType -> String
$cshow :: SourceType -> String
showsPrec :: Int -> SourceType -> String -> String
$cshowsPrec :: Int -> SourceType -> String -> String
Show)
data Config region = Config
{
forall region. Config region -> [DynOption]
cfgDynOptions :: ![DynOption],
forall region. Config region -> FixityMap
cfgFixityOverrides :: FixityMap,
forall region. Config region -> Set String
cfgDependencies :: !(Set String),
forall region. Config region -> Bool
cfgUnsafe :: !Bool,
forall region. Config region -> Bool
cfgDebug :: !Bool,
forall region. Config region -> Bool
cfgCheckIdempotence :: !Bool,
forall region. Config region -> SourceType
cfgSourceType :: !SourceType,
forall region. Config region -> ColorMode
cfgColorMode :: !ColorMode,
forall region. Config region -> region
cfgRegion :: !region,
forall region. Config region -> PrinterOptsTotal
cfgPrinterOpts :: !PrinterOptsTotal
}
deriving (Config region -> Config region -> Bool
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 -> String -> String
forall region.
Show region =>
Int -> Config region -> String -> String
forall region. Show region => [Config region] -> String -> String
forall region. Show region => Config region -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Config region] -> String -> String
$cshowList :: forall region. Show region => [Config region] -> String -> String
show :: Config region -> String
$cshow :: forall region. Show region => Config region -> String
showsPrec :: Int -> Config region -> String -> String
$cshowsPrec :: forall region.
Show region =>
Int -> Config region -> String -> String
Show, 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
<$ :: forall a b. a -> Config b -> Config a
$c<$ :: forall a b. a -> Config b -> Config a
fmap :: forall a b. (a -> b) -> Config a -> Config b
$cfmap :: forall a b. (a -> b) -> Config a -> Config b
Functor, 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
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 -> String -> String
[RegionIndices] -> String -> String
RegionIndices -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegionIndices] -> String -> String
$cshowList :: [RegionIndices] -> String -> String
show :: RegionIndices -> String
$cshow :: RegionIndices -> String
showsPrec :: Int -> RegionIndices -> String -> String
$cshowsPrec :: Int -> RegionIndices -> String -> String
Show)
data RegionDeltas = RegionDeltas
{
RegionDeltas -> Int
regionPrefixLength :: !Int,
RegionDeltas -> Int
regionSuffixLength :: !Int
}
deriving (RegionDeltas -> RegionDeltas -> Bool
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 -> String -> String
[RegionDeltas] -> String -> String
RegionDeltas -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegionDeltas] -> String -> String
$cshowList :: [RegionDeltas] -> String -> String
show :: RegionDeltas -> String
$cshow :: RegionDeltas -> String
showsPrec :: Int -> RegionDeltas -> String -> String
$cshowsPrec :: Int -> RegionDeltas -> String -> String
Show)
defaultConfig :: Config RegionIndices
defaultConfig :: Config RegionIndices
defaultConfig =
Config
{ cfgDynOptions :: [DynOption]
cfgDynOptions = [],
cfgFixityOverrides :: FixityMap
cfgFixityOverrides = forall k a. Map k a
Map.empty,
cfgDependencies :: Set String
cfgDependencies = 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
{ regionStartLine :: Maybe Int
regionStartLine = forall a. Maybe a
Nothing,
regionEndLine :: Maybe Int
regionEndLine = 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
{ regionPrefixLength :: Int
regionPrefixLength = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
subtract Int
1) Maybe Int
regionStartLine,
regionSuffixLength :: Int
regionSuffixLength = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
total forall a. Num a => a -> a -> a
-) Maybe Int
regionEndLine
}
newtype DynOption = DynOption
{ DynOption -> String
unDynOption :: String
}
deriving (DynOption -> DynOption -> Bool
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
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
Ord, Int -> DynOption -> String -> String
[DynOption] -> String -> String
DynOption -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DynOption] -> String -> String
$cshowList :: [DynOption] -> String -> String
show :: DynOption -> String
$cshow :: DynOption -> String
showsPrec :: Int -> DynOption -> String -> String
$cshowsPrec :: Int -> DynOption -> String -> String
Show)
dynOptionToLocatedStr :: DynOption -> GHC.Located String
dynOptionToLocatedStr :: DynOption -> Located String
dynOptionToLocatedStr (DynOption String
o) = 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
(<>) = 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 =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PrinterOpts" forall a b. (a -> b) -> a -> b
$ \Object
o ->
forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM (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 :: forall a. 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 = forall a. IsString a => String -> a
fromString String
metaName
Maybe Value
mValue <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
key
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Value
mValue forall a b. (a -> b) -> a -> b
$ \Value
value ->
forall a. PrinterOptsFieldType a => Value -> Parser a
parseJSON Value
value 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 (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields forall a. f a -> g a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. f a -> g a
f)
overFieldsM :: Applicative m => (forall a. f a -> m (g a)) -> PrinterOpts f -> m (PrinterOpts g)
overFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(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 <- forall a. f a -> m (g a)
f f Int
poIndentation0
g CommaStyle
poCommaStyle <- forall a. f a -> m (g a)
f f CommaStyle
poCommaStyle0
g ImportExportStyle
poImportExportStyle <- forall a. f a -> m (g a)
f f ImportExportStyle
poImportExportStyle0
g Bool
poIndentWheres <- forall a. f a -> m (g a)
f f Bool
poIndentWheres0
g Bool
poRecordBraceSpace <- forall a. f a -> m (g a)
f f Bool
poRecordBraceSpace0
g Bool
poRespectful <- forall a. f a -> m (g a)
f f Bool
poRespectful0
g HaddockPrintStyle
poHaddockStyle <- forall a. f a -> m (g a)
f f HaddockPrintStyle
poHaddockStyle0
g Int
poNewlinesBetweenDecls <- forall a. f a -> m (g a)
f f Int
poNewlinesBetweenDecls0
return PrinterOpts {g Bool
g Int
g ImportExportStyle
g HaddockPrintStyle
g CommaStyle
poNewlinesBetweenDecls :: g Int
poHaddockStyle :: g HaddockPrintStyle
poRespectful :: g Bool
poRecordBraceSpace :: g Bool
poIndentWheres :: g Bool
poImportExportStyle :: g ImportExportStyle
poCommaStyle :: g CommaStyle
poIndentation :: g Int
poNewlinesBetweenDecls :: g Int
poHaddockStyle :: g HaddockPrintStyle
poRespectful :: g Bool
poRecordBraceSpace :: g Bool
poIndentWheres :: g Bool
poImportExportStyle :: g ImportExportStyle
poCommaStyle :: g CommaStyle
poIndentation :: g Int
..}
defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts :: PrinterOptsTotal
defaultPrinterOpts = forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> PrinterOpts f -> PrinterOpts g
overFields (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrinterOptsFieldMeta a -> a
metaDefault) PrinterOpts PrinterOptsFieldMeta
printerOptsMeta
fillMissingPrinterOpts ::
forall f.
Applicative f =>
PrinterOptsPartial ->
PrinterOpts f ->
PrinterOpts f
fillMissingPrinterOpts :: forall (f :: * -> *).
Applicative f =>
PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts PrinterOptsPartial
p1 PrinterOpts f
p2 = 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 :: forall a. PrinterOptsFieldMeta a -> f a
fillField PrinterOptsFieldMeta a
meta = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField PrinterOptsFieldMeta a
meta PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField PrinterOptsFieldMeta a
meta PrinterOptsPartial
p1)
data PrinterOptsFieldMeta a where
PrinterOptsFieldMeta ::
PrinterOptsFieldType a =>
{ forall a. PrinterOptsFieldMeta a -> String
metaName :: String,
forall a.
PrinterOptsFieldMeta a
-> forall (f :: * -> *). PrinterOpts f -> f a
metaGetField :: forall f. PrinterOpts f -> f a,
forall a. PrinterOptsFieldMeta a -> String
metaPlaceholder :: String,
forall a. PrinterOptsFieldMeta a -> String
metaHelp :: String,
forall a. PrinterOptsFieldMeta a -> a
metaDefault :: a
} ->
PrinterOptsFieldMeta a
printerOptsMeta :: PrinterOpts PrinterOptsFieldMeta
printerOptsMeta :: PrinterOpts PrinterOptsFieldMeta
printerOptsMeta =
PrinterOpts
{ poIndentation :: PrinterOptsFieldMeta Int
poIndentation =
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
{ 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 =
forall r. PrintfType r => String -> r
printf
String
"How to place commas in multi-line lists, records, etc. (choices: %s)"
(forall a. BijectiveMap a -> String
showAllValues BijectiveMap CommaStyle
commaStyleMap),
metaDefault :: CommaStyle
metaDefault = CommaStyle
Leading
},
poImportExportStyle :: PrinterOptsFieldMeta ImportExportStyle
poImportExportStyle =
PrinterOptsFieldMeta
{ metaName :: String
metaName = String
"import-export-style",
metaGetField :: forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
metaGetField = forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle,
metaPlaceholder :: String
metaPlaceholder = String
"STYLE",
metaHelp :: String
metaHelp = String
"Styling of import/export lists",
metaDefault :: ImportExportStyle
metaDefault = ImportExportStyle
ImportExportDiffFriendly
},
poIndentWheres :: PrinterOptsFieldMeta Bool
poIndentWheres =
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
{ 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
},
poRespectful :: PrinterOptsFieldMeta Bool
poRespectful =
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
{ 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 =
forall r. PrintfType r => String -> r
printf
String
"How to print Haddock comments (choices: %s)"
(forall a. BijectiveMap a -> String
showAllValues BijectiveMap HaddockPrintStyle
haddockPrintStyleMap),
metaDefault :: HaddockPrintStyle
metaDefault = HaddockPrintStyle
HaddockMultiLine
},
poNewlinesBetweenDecls :: PrinterOptsFieldMeta Int
poNewlinesBetweenDecls =
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 = forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON
parseText :: String -> Either String a
default parseText :: Read a => String -> Either String a
parseText = forall a. Read a => String -> Either String a
readEither
showText :: a -> String
default showText :: Show a => a -> String
showText = forall a. Show a => a -> String
show
instance PrinterOptsFieldType Int
instance PrinterOptsFieldType Bool where
parseText :: String -> Either String Bool
parseText = \case
String
"false" -> forall a b. b -> Either a b
Right Bool
False
String
"true" -> forall a b. b -> Either a b
Right Bool
True
String
unknown ->
forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
[ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> 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")
]
)
importExportStyleMap :: BijectiveMap ImportExportStyle
importExportStyleMap :: BijectiveMap ImportExportStyle
importExportStyleMap =
$( mkBijectiveMap
[ ('ImportExportLeading, "leading"),
('ImportExportTrailing, "trailing"),
('ImportExportDiffFriendly, "diff-friendly")
]
)
instance PrinterOptsFieldType CommaStyle where
parseJSON :: Value -> Parser CommaStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap CommaStyle
commaStyleMap String
"CommaStyle"
parseText :: String -> Either String CommaStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap CommaStyle
commaStyleMap
showText :: CommaStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap CommaStyle
commaStyleMap
instance PrinterOptsFieldType HaddockPrintStyle where
parseJSON :: Value -> Parser HaddockPrintStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap String
"HaddockPrintStyle"
parseText :: String -> Either String HaddockPrintStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap
showText :: HaddockPrintStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap HaddockPrintStyle
haddockPrintStyleMap
instance PrinterOptsFieldType ImportExportStyle where
parseJSON :: Value -> Parser ImportExportStyle
parseJSON = forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap ImportExportStyle
importExportStyleMap String
"ImportExportStyle"
parseText :: String -> Either String ImportExportStyle
parseText = forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap ImportExportStyle
importExportStyleMap
showText :: ImportExportStyle -> String
showText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> a -> String
showTextWith BijectiveMap ImportExportStyle
importExportStyleMap
parseJSONWith :: BijectiveMap a -> String -> Aeson.Value -> Aeson.Parser a
parseJSONWith :: forall a. BijectiveMap a -> String -> Value -> Parser a
parseJSONWith BijectiveMap a
mapping String
name =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
name (forall {a}. Either String a -> Parser a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BijectiveMap a -> String -> Either String a
parseTextWith BijectiveMap a
mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
where
fromEither :: Either String a -> Parser a
fromEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure
data FourmoluConfig = FourmoluConfig
{ FourmoluConfig -> PrinterOptsPartial
cfgFilePrinterOpts :: PrinterOptsPartial,
FourmoluConfig -> FixityMap
cfgFileFixities :: FixityMap
}
deriving (FourmoluConfig -> FourmoluConfig -> Bool
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 -> String -> String
[FourmoluConfig] -> String -> String
FourmoluConfig -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FourmoluConfig] -> String -> String
$cshowList :: [FourmoluConfig] -> String -> String
show :: FourmoluConfig -> String
$cshow :: FourmoluConfig -> String
showsPrec :: Int -> FourmoluConfig -> String -> String
$cshowsPrec :: Int -> FourmoluConfig -> String -> String
Show)
instance Aeson.FromJSON FourmoluConfig where
parseJSON :: Value -> Parser FourmoluConfig
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"FourmoluConfig" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
PrinterOptsPartial
cfgFilePrinterOpts <- forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
[Text]
rawFixities <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixities" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
FixityMap
cfgFileFixities <-
case 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [[(String, FixityInfo)]]
fixities
Left ParseErrorBundle Text Void
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e
return 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 = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String
xdg forall a. a -> [a] -> [a]
: forall a. (a -> a -> a) -> [a] -> [a]
scanl1 String -> String -> String
(</>) (String -> [String]
splitPath String
root)
[String] -> String -> IO (Maybe String)
findFile [String]
dirs String
configFileName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> ConfigFileLoadResult
ConfigNotFound [String]
dirs
Just String
file ->
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)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> String -> String
[ConfigFileLoadResult] -> String -> String
ConfigFileLoadResult -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConfigFileLoadResult] -> String -> String
$cshowList :: [ConfigFileLoadResult] -> String -> String
show :: ConfigFileLoadResult -> String
$cshow :: ConfigFileLoadResult -> String
showsPrec :: Int -> ConfigFileLoadResult -> String -> String
$cshowsPrec :: Int -> ConfigFileLoadResult -> String -> String
Show)
configFileName :: FilePath
configFileName :: String
configFileName = String
"fourmolu.yaml"