{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.Haskell.Stylish.Config
( Extensions
, Config (..)
, ExitCodeBehavior (..)
, defaultConfigBytes
, configFilePath
, loadConfig
, parseConfig
) where
import Control.Applicative ((<|>))
import Control.Monad (forM, mzero)
import Data.Aeson (FromJSON (..))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Data.ByteString as B
import Data.ByteString.Lazy (fromStrict)
import Data.Char (toLower)
import qualified Data.FileEmbed as FileEmbed
import Data.List (intercalate,
nub)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.YAML (prettyPosWithSource)
import Data.YAML.Aeson (decode1Strict)
import System.Directory
import System.FilePath ((</>))
import qualified System.IO as IO (Newline (..),
nativeNewline)
import Text.Read (readMaybe)
import qualified Language.Haskell.Stylish.Config.Cabal as Cabal
import Language.Haskell.Stylish.Config.Internal
import Language.Haskell.Stylish.Step
import qualified Language.Haskell.Stylish.Step.Data as Data
import qualified Language.Haskell.Stylish.Step.Imports as Imports
import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas
import qualified Language.Haskell.Stylish.Step.ModuleHeader as ModuleHeader
import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign
import qualified Language.Haskell.Stylish.Step.Squash as Squash
import qualified Language.Haskell.Stylish.Step.Tabs as Tabs
import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace
import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax
import Language.Haskell.Stylish.Verbose
type Extensions = [String]
data Config = Config
{ Config -> [Step]
configSteps :: [Step]
, Config -> Maybe Int
configColumns :: Maybe Int
, Config -> [[Char]]
configLanguageExtensions :: [String]
, Config -> Newline
configNewline :: IO.Newline
, Config -> Bool
configCabal :: Bool
, Config -> ExitCodeBehavior
configExitCode :: ExitCodeBehavior
}
data ExitCodeBehavior
= NormalExitBehavior
| ErrorOnFormatExitBehavior
deriving (ExitCodeBehavior -> ExitCodeBehavior -> Bool
(ExitCodeBehavior -> ExitCodeBehavior -> Bool)
-> (ExitCodeBehavior -> ExitCodeBehavior -> Bool)
-> Eq ExitCodeBehavior
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
== :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
$c/= :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
/= :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
Eq)
instance Show ExitCodeBehavior where
show :: ExitCodeBehavior -> [Char]
show ExitCodeBehavior
NormalExitBehavior = [Char]
"normal"
show ExitCodeBehavior
ErrorOnFormatExitBehavior = [Char]
"error_on_format"
instance FromJSON Config where
parseJSON :: Value -> Parser Config
parseJSON = Value -> Parser Config
parseConfig
configFileName :: String
configFileName :: [Char]
configFileName = [Char]
".stylish-haskell.yaml"
defaultConfigBytes :: B.ByteString
defaultConfigBytes :: ByteString
defaultConfigBytes = $(FileEmbed.embedFile "data/stylish-haskell.yaml")
configFilePath :: Verbose -> Maybe FilePath -> IO (Maybe FilePath)
configFilePath :: Verbose -> Maybe [Char] -> IO (Maybe [Char])
configFilePath Verbose
_ (Just [Char]
userSpecified) = Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
userSpecified)
configFilePath Verbose
verbose Maybe [Char]
Nothing = do
[Char]
current <- IO [Char]
getCurrentDirectory
[Char]
configPath <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"stylish-haskell"
[Char]
home <- IO [Char]
getHomeDirectory
Verbose -> [[Char]] -> IO (Maybe [Char])
search Verbose
verbose ([[Char]] -> IO (Maybe [Char])) -> [[Char]] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
[[Char]
d [Char] -> ShowS
</> [Char]
configFileName | [Char]
d <- [Char] -> [[Char]]
ancestors [Char]
current] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[[Char]
configPath [Char] -> ShowS
</> [Char]
"config.yaml", [Char]
home [Char] -> ShowS
</> [Char]
configFileName]
search :: Verbose -> [FilePath] -> IO (Maybe FilePath)
search :: Verbose -> [[Char]] -> IO (Maybe [Char])
search Verbose
_ [] = Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
search Verbose
verbose ([Char]
f : [[Char]]
fs) = do
Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
f
Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ [Char]
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
exists then [Char]
" exists" else [Char]
" does not exist"
if Bool
exists then Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f) else Verbose -> [[Char]] -> IO (Maybe [Char])
search Verbose
verbose [[Char]]
fs
loadConfig :: Verbose -> Maybe FilePath -> IO Config
loadConfig :: Verbose -> Maybe [Char] -> IO Config
loadConfig Verbose
verbose Maybe [Char]
userSpecified = do
Maybe [Char]
mbFp <- Verbose -> Maybe [Char] -> IO (Maybe [Char])
configFilePath Verbose
verbose Maybe [Char]
userSpecified
Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ [Char]
"Loading configuration at " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"<embedded>" Maybe [Char]
mbFp
ByteString
bytes <- IO ByteString
-> ([Char] -> IO ByteString) -> Maybe [Char] -> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
defaultConfigBytes) [Char] -> IO ByteString
B.readFile Maybe [Char]
mbFp
case ByteString -> Either (Pos, [Char]) Config
forall v. FromJSON v => ByteString -> Either (Pos, [Char]) v
decode1Strict ByteString
bytes of
Left (Pos
pos, [Char]
err) -> [Char] -> IO Config
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO Config) -> [Char] -> IO Config
forall a b. (a -> b) -> a -> b
$ Pos -> ByteString -> ShowS
prettyPosWithSource Pos
pos (ByteString -> ByteString
fromStrict ByteString
bytes) ([Char]
"Language.Haskell.Stylish.Config.loadConfig: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err)
Right Config
config -> do
[[Char]]
cabalLanguageExtensions <- if Config -> Bool
configCabal Config
config
then ((KnownExtension, Bool) -> [Char])
-> [(KnownExtension, Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (KnownExtension, Bool) -> [Char]
forall {a}. Show a => (a, Bool) -> [Char]
toStr ([(KnownExtension, Bool)] -> [[Char]])
-> IO [(KnownExtension, Bool)] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbose -> IO [(KnownExtension, Bool)]
Cabal.findLanguageExtensions Verbose
verbose
else [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ Config
config
{ configLanguageExtensions = nub $
configLanguageExtensions config ++ cabalLanguageExtensions
}
where toStr :: (a, Bool) -> [Char]
toStr (a
ext, Bool
True) = a -> [Char]
forall a. Show a => a -> [Char]
show a
ext
toStr (a
ext, Bool
False) = [Char]
"No" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
ext
parseConfig :: A.Value -> A.Parser Config
parseConfig :: Value -> Parser Config
parseConfig (A.Object Object
o) = do
Config
config <- [Step]
-> Maybe Int
-> [[Char]]
-> Newline
-> Bool
-> ExitCodeBehavior
-> Config
Config
([Step]
-> Maybe Int
-> [[Char]]
-> Newline
-> Bool
-> ExitCodeBehavior
-> Config)
-> Parser [Step]
-> Parser
(Maybe Int
-> [[Char]] -> Newline -> Bool -> ExitCodeBehavior -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Step] -> Parser [Step]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Parser
(Maybe Int
-> [[Char]] -> Newline -> Bool -> ExitCodeBehavior -> Config)
-> Parser (Maybe Int)
-> Parser
([[Char]] -> Newline -> Bool -> ExitCodeBehavior -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Maybe Int))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:! Key
"columns" Parser (Maybe (Maybe Int)) -> Maybe Int -> Parser (Maybe Int)
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
80)
Parser ([[Char]] -> Newline -> Bool -> ExitCodeBehavior -> Config)
-> Parser [[Char]]
-> Parser (Newline -> Bool -> ExitCodeBehavior -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [[Char]])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"language_extensions" Parser (Maybe [[Char]]) -> [[Char]] -> Parser [[Char]]
forall a. Parser (Maybe a) -> a -> Parser a
A..!= [])
Parser (Newline -> Bool -> ExitCodeBehavior -> Config)
-> Parser Newline -> Parser (Bool -> ExitCodeBehavior -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"newline" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser Newline) -> Parser Newline
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], Newline)] -> Newline -> Maybe [Char] -> Parser Newline
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], Newline)]
newlines Newline
IO.nativeNewline)
Parser (Bool -> ExitCodeBehavior -> Config)
-> Parser Bool -> Parser (ExitCodeBehavior -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"cabal" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True)
Parser (ExitCodeBehavior -> Config)
-> Parser ExitCodeBehavior -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"exit_code" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser ExitCodeBehavior)
-> Parser ExitCodeBehavior
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], ExitCodeBehavior)]
-> ExitCodeBehavior -> Maybe [Char] -> Parser ExitCodeBehavior
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], ExitCodeBehavior)]
exitCodes ExitCodeBehavior
NormalExitBehavior)
[Value]
stepValues <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"steps" :: A.Parser [A.Value]
[[Step]]
steps <- (Value -> Parser [Step]) -> [Value] -> Parser [[Step]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Config -> Value -> Parser [Step]
parseSteps Config
config) [Value]
stepValues
Config -> Parser Config
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config {configSteps = concat steps}
where
newlines :: [([Char], Newline)]
newlines =
[ ([Char]
"native", Newline
IO.nativeNewline)
, ([Char]
"lf", Newline
IO.LF)
, ([Char]
"crlf", Newline
IO.CRLF)
]
exitCodes :: [([Char], ExitCodeBehavior)]
exitCodes =
[ ([Char]
"normal", ExitCodeBehavior
NormalExitBehavior)
, ([Char]
"error_on_format", ExitCodeBehavior
ErrorOnFormatExitBehavior)
]
parseConfig Value
_ = Parser Config
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
catalog :: Map String (Config -> A.Object -> A.Parser Step)
catalog :: Map [Char] (Config -> Object -> Parser Step)
catalog = [([Char], Config -> Object -> Parser Step)]
-> Map [Char] (Config -> Object -> Parser Step)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ ([Char]
"imports", Config -> Object -> Parser Step
parseImports)
, ([Char]
"module_header", Config -> Object -> Parser Step
parseModuleHeader)
, ([Char]
"records", Config -> Object -> Parser Step
parseRecords)
, ([Char]
"language_pragmas", Config -> Object -> Parser Step
parseLanguagePragmas)
, ([Char]
"simple_align", Config -> Object -> Parser Step
parseSimpleAlign)
, ([Char]
"squash", Config -> Object -> Parser Step
parseSquash)
, ([Char]
"tabs", Config -> Object -> Parser Step
parseTabs)
, ([Char]
"trailing_whitespace", Config -> Object -> Parser Step
parseTrailingWhitespace)
, ([Char]
"unicode_syntax", Config -> Object -> Parser Step
parseUnicodeSyntax)
]
parseSteps :: Config -> A.Value -> A.Parser [Step]
parseSteps :: Config -> Value -> Parser [Step]
parseSteps Config
config Value
val = do
Map [Char] Value
map' <- Value -> Parser (Map [Char] Value)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val :: A.Parser (Map String A.Value)
[([Char], Value)]
-> (([Char], Value) -> Parser Step) -> Parser [Step]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map [Char] Value -> [([Char], Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] Value
map') ((([Char], Value) -> Parser Step) -> Parser [Step])
-> (([Char], Value) -> Parser Step) -> Parser [Step]
forall a b. (a -> b) -> a -> b
$ \([Char]
k, Value
v) -> case ([Char]
-> Map [Char] (Config -> Object -> Parser Step)
-> Maybe (Config -> Object -> Parser Step)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
k Map [Char] (Config -> Object -> Parser Step)
catalog, Value
v) of
(Just Config -> Object -> Parser Step
parser, A.Object Object
o) -> Config -> Object -> Parser Step
parser Config
config Object
o
(Maybe (Config -> Object -> Parser Step), Value)
_ -> [Char] -> Parser Step
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Step) -> [Char] -> Parser Step
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid declaration for " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
k
parseEnum :: [(String, a)] -> a -> Maybe String -> A.Parser a
parseEnum :: forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], a)]
_ a
def Maybe [Char]
Nothing = a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def
parseEnum [([Char], a)]
strs a
_ (Just [Char]
k) = case [Char] -> [([Char], a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
k [([Char], a)]
strs of
Just a
v -> a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Maybe a
Nothing -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown option: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", should be one of: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((([Char], a) -> [Char]) -> [([Char], a)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], a) -> [Char]
forall a b. (a, b) -> a
fst [([Char], a)]
strs)
parseModuleHeader :: Config -> A.Object -> A.Parser Step
Config
config Object
o = (Config -> Step) -> Parser Config -> Parser Step
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> Config -> Step
ModuleHeader.step Maybe Int
columns) (Parser Config -> Parser Step) -> Parser Config -> Parser Step
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Bool -> BreakWhere -> OpenBracket -> Config
ModuleHeader.Config
(Int -> Bool -> Bool -> BreakWhere -> OpenBracket -> Config)
-> Parser Int
-> Parser (Bool -> Bool -> BreakWhere -> OpenBracket -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"indent" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Config -> Int
ModuleHeader.indent Config
def)
Parser (Bool -> Bool -> BreakWhere -> OpenBracket -> Config)
-> Parser Bool
-> Parser (Bool -> BreakWhere -> OpenBracket -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"sort" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Config -> Bool
ModuleHeader.sort Config
def)
Parser (Bool -> BreakWhere -> OpenBracket -> Config)
-> Parser Bool -> Parser (BreakWhere -> OpenBracket -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"separate_lists" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Config -> Bool
ModuleHeader.separateLists Config
def)
Parser (BreakWhere -> OpenBracket -> Config)
-> Parser BreakWhere -> Parser (OpenBracket -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"break_where" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser BreakWhere) -> Parser BreakWhere
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], BreakWhere)]
-> BreakWhere -> Maybe [Char] -> Parser BreakWhere
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], BreakWhere)]
breakWhere (Config -> BreakWhere
ModuleHeader.breakWhere Config
def))
Parser (OpenBracket -> Config)
-> Parser OpenBracket -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"open_bracket" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser OpenBracket) -> Parser OpenBracket
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], OpenBracket)]
-> OpenBracket -> Maybe [Char] -> Parser OpenBracket
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], OpenBracket)]
openBracket (Config -> OpenBracket
ModuleHeader.openBracket Config
def))
where
def :: Config
def = Config
ModuleHeader.defaultConfig
columns :: Maybe Int
columns = Config -> Maybe Int
configColumns Config
config
breakWhere :: [([Char], BreakWhere)]
breakWhere =
[ ([Char]
"exports", BreakWhere
ModuleHeader.Exports)
, ([Char]
"single", BreakWhere
ModuleHeader.Single)
, ([Char]
"inline", BreakWhere
ModuleHeader.Inline)
, ([Char]
"always", BreakWhere
ModuleHeader.Always)
]
openBracket :: [([Char], OpenBracket)]
openBracket =
[ ([Char]
"same_line", OpenBracket
ModuleHeader.SameLine)
, ([Char]
"next_line", OpenBracket
ModuleHeader.NextLine)
]
parseSimpleAlign :: Config -> A.Object -> A.Parser Step
parseSimpleAlign :: Config -> Object -> Parser Step
parseSimpleAlign Config
c Object
o = Maybe Int -> Config -> Step
SimpleAlign.step
(Maybe Int -> Config -> Step)
-> Parser (Maybe Int) -> Parser (Config -> Step)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Parser (Maybe Int)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Maybe Int
configColumns Config
c)
Parser (Config -> Step) -> Parser Config -> Parser Step
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Align -> Align -> Align -> Align -> Config
SimpleAlign.Config
(Align -> Align -> Align -> Align -> Config)
-> Parser Align -> Parser (Align -> Align -> Align -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> (Config -> Align) -> Parser Align
parseAlign Key
"cases" Config -> Align
SimpleAlign.cCases
Parser (Align -> Align -> Align -> Config)
-> Parser Align -> Parser (Align -> Align -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (Config -> Align) -> Parser Align
parseAlign Key
"top_level_patterns" Config -> Align
SimpleAlign.cTopLevelPatterns
Parser (Align -> Align -> Config)
-> Parser Align -> Parser (Align -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (Config -> Align) -> Parser Align
parseAlign Key
"records" Config -> Align
SimpleAlign.cRecords
Parser (Align -> Config) -> Parser Align -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (Config -> Align) -> Parser Align
parseAlign Key
"multi_way_if" Config -> Align
SimpleAlign.cMultiWayIf)
where
parseAlign :: Key -> (Config -> Align) -> Parser Align
parseAlign Key
key Config -> Align
f =
(Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
key Parser (Maybe [Char])
-> (Maybe [Char] -> Parser Align) -> Parser Align
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], Align)] -> Align -> Maybe [Char] -> Parser Align
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], Align)]
aligns (Config -> Align
f Config
SimpleAlign.defaultConfig)) Parser Align -> Parser Align -> Parser Align
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Bool -> Align
boolToAlign (Bool -> Align) -> Parser Bool -> Parser Align
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
key)
aligns :: [([Char], Align)]
aligns =
[ ([Char]
"always", Align
SimpleAlign.Always)
, ([Char]
"adjacent", Align
SimpleAlign.Adjacent)
, ([Char]
"never", Align
SimpleAlign.Never)
]
boolToAlign :: Bool -> Align
boolToAlign Bool
True = Align
SimpleAlign.Always
boolToAlign Bool
False = Align
SimpleAlign.Never
parseRecords :: Config -> A.Object -> A.Parser Step
parseRecords :: Config -> Object -> Parser Step
parseRecords Config
c Object
o = Config -> Step
Data.step
(Config -> Step) -> Parser Config -> Parser Step
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Indent
-> Indent
-> Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config
Data.Config
(Indent
-> Indent
-> Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config)
-> Parser Indent
-> Parser
(Indent
-> Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"equals" Parser Value -> (Value -> Parser Indent) -> Parser Indent
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Indent
parseIndent)
Parser
(Indent
-> Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config)
-> Parser Indent
-> Parser
(Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"first_field" Parser Value -> (Value -> Parser Indent) -> Parser Indent
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Indent
parseIndent)
Parser
(Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config)
-> Parser Int
-> Parser
(Int
-> Bool -> Bool -> Indent -> Bool -> Bool -> MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"field_comment")
Parser
(Int
-> Bool -> Bool -> Indent -> Bool -> Bool -> MaxColumns -> Config)
-> Parser Int
-> Parser
(Bool -> Bool -> Indent -> Bool -> Bool -> MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"deriving")
Parser
(Bool -> Bool -> Indent -> Bool -> Bool -> MaxColumns -> Config)
-> Parser Bool
-> Parser (Bool -> Indent -> Bool -> Bool -> MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"break_enums" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False)
Parser (Bool -> Indent -> Bool -> Bool -> MaxColumns -> Config)
-> Parser Bool
-> Parser (Indent -> Bool -> Bool -> MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"break_single_constructors" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True)
Parser (Indent -> Bool -> Bool -> MaxColumns -> Config)
-> Parser Indent -> Parser (Bool -> Bool -> MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"via" Parser Value -> (Value -> Parser Indent) -> Parser Indent
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Indent
parseIndent)
Parser (Bool -> Bool -> MaxColumns -> Config)
-> Parser Bool -> Parser (Bool -> MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"curried_context" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False)
Parser (Bool -> MaxColumns -> Config)
-> Parser Bool -> Parser (MaxColumns -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"sort_deriving" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True)
Parser (MaxColumns -> Config) -> Parser MaxColumns -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MaxColumns -> Parser MaxColumns
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaxColumns
configMaxColumns)
where
configMaxColumns :: MaxColumns
configMaxColumns =
MaxColumns -> (Int -> MaxColumns) -> Maybe Int -> MaxColumns
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaxColumns
Data.NoMaxColumns Int -> MaxColumns
Data.MaxColumns (Config -> Maybe Int
configColumns Config
c)
parseIndent :: A.Value -> A.Parser Data.Indent
parseIndent :: Value -> Parser Indent
parseIndent = \case
A.String Text
"same_line" -> Indent -> Parser Indent
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Indent
Data.SameLine
A.String Text
t | Text
"indent " Text -> Text -> Bool
`T.isPrefixOf` Text
t ->
case [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
7 Text
t) of
Just Int
n -> Indent -> Parser Indent
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Indent -> Parser Indent) -> Indent -> Parser Indent
forall a b. (a -> b) -> a -> b
$ Int -> Indent
Data.Indent Int
n
Maybe Int
Nothing -> [Char] -> Parser Indent
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Indent) -> [Char] -> Parser Indent
forall a b. (a -> b) -> a -> b
$ [Char]
"Indent: not a number" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Int -> Text -> Text
T.drop Int
7 Text
t)
A.String Text
t -> [Char] -> Parser Indent
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Indent) -> [Char] -> Parser Indent
forall a b. (a -> b) -> a -> b
$ [Char]
"can't parse indent setting: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
t
Value
_ -> [Char] -> Parser Indent
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected string for indent value"
parseSquash :: Config -> A.Object -> A.Parser Step
parseSquash :: Config -> Object -> Parser Step
parseSquash Config
_ Object
_ = Step -> Parser Step
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
Squash.step
parseImports :: Config -> A.Object -> A.Parser Step
parseImports :: Config -> Object -> Parser Step
parseImports Config
config Object
o = (Options -> Step) -> Parser Options -> Parser Step
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> Options -> Step
Imports.step Maybe Int
columns) (Parser Options -> Parser Step) -> Parser Options -> Parser Step
forall a b. (a -> b) -> a -> b
$ ImportAlign
-> ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options
Imports.Options
(ImportAlign
-> ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
-> Parser ImportAlign
-> Parser
(ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"align" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser ImportAlign) -> Parser ImportAlign
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], ImportAlign)]
-> ImportAlign -> Maybe [Char] -> Parser ImportAlign
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], ImportAlign)]
aligns ((Options -> ImportAlign) -> ImportAlign
forall {t}. (Options -> t) -> t
def Options -> ImportAlign
Imports.importAlign))
Parser
(ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
-> Parser ListAlign
-> Parser
(Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"list_align" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser ListAlign) -> Parser ListAlign
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], ListAlign)]
-> ListAlign -> Maybe [Char] -> Parser ListAlign
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], ListAlign)]
listAligns ((Options -> ListAlign) -> ListAlign
forall {t}. (Options -> t) -> t
def Options -> ListAlign
Imports.listAlign))
Parser
(Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
-> Parser Bool
-> Parser
(LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"pad_module_names" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= (Options -> Bool) -> Bool
forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.padModuleNames)
Parser
(LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
-> Parser LongListAlign
-> Parser
(EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"long_list_align" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser LongListAlign) -> Parser LongListAlign
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], LongListAlign)]
-> LongListAlign -> Maybe [Char] -> Parser LongListAlign
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], LongListAlign)]
longListAligns ((Options -> LongListAlign) -> LongListAlign
forall {t}. (Options -> t) -> t
def Options -> LongListAlign
Imports.longListAlign))
Parser
(EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options)
-> Parser EmptyListAlign
-> Parser
(ListPadding
-> Bool -> Bool -> Bool -> Bool -> [GroupRule] -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"empty_list_align" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser EmptyListAlign) -> Parser EmptyListAlign
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], EmptyListAlign)]
-> EmptyListAlign -> Maybe [Char] -> Parser EmptyListAlign
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], EmptyListAlign)]
emptyListAligns ((Options -> EmptyListAlign) -> EmptyListAlign
forall {t}. (Options -> t) -> t
def Options -> EmptyListAlign
Imports.emptyListAlign))
Parser
(ListPadding
-> Bool -> Bool -> Bool -> Bool -> [GroupRule] -> Options)
-> Parser ListPadding
-> Parser (Bool -> Bool -> Bool -> Bool -> [GroupRule] -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"list_padding" Parser (Maybe Value)
-> (Maybe Value -> Parser ListPadding) -> Parser ListPadding
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser ListPadding
-> (Value -> Parser ListPadding)
-> Maybe Value
-> Parser ListPadding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ListPadding -> Parser ListPadding
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListPadding -> Parser ListPadding)
-> ListPadding -> Parser ListPadding
forall a b. (a -> b) -> a -> b
$ (Options -> ListPadding) -> ListPadding
forall {t}. (Options -> t) -> t
def Options -> ListPadding
Imports.listPadding) Value -> Parser ListPadding
parseListPadding)
Parser (Bool -> Bool -> Bool -> Bool -> [GroupRule] -> Options)
-> Parser Bool
-> Parser (Bool -> Bool -> Bool -> [GroupRule] -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"separate_lists" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= (Options -> Bool) -> Bool
forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.separateLists
Parser (Bool -> Bool -> Bool -> [GroupRule] -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> [GroupRule] -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"space_surround" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= (Options -> Bool) -> Bool
forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.spaceSurround
Parser (Bool -> Bool -> [GroupRule] -> Options)
-> Parser Bool -> Parser (Bool -> [GroupRule] -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"post_qualify" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= (Options -> Bool) -> Bool
forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.postQualified
Parser (Bool -> [GroupRule] -> Options)
-> Parser Bool -> Parser ([GroupRule] -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"group_imports" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= (Options -> Bool) -> Bool
forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.groupImports
Parser ([GroupRule] -> Options)
-> Parser [GroupRule] -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [GroupRule])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"group_rules" Parser (Maybe [GroupRule]) -> [GroupRule] -> Parser [GroupRule]
forall a. Parser (Maybe a) -> a -> Parser a
A..!= (Options -> [GroupRule]) -> [GroupRule]
forall {t}. (Options -> t) -> t
def Options -> [GroupRule]
Imports.groupRules
where
def :: (Options -> t) -> t
def Options -> t
f = Options -> t
f Options
Imports.defaultOptions
columns :: Maybe Int
columns = Config -> Maybe Int
configColumns Config
config
aligns :: [([Char], ImportAlign)]
aligns =
[ ([Char]
"global", ImportAlign
Imports.Global)
, ([Char]
"file", ImportAlign
Imports.File)
, ([Char]
"group", ImportAlign
Imports.Group)
, ([Char]
"none", ImportAlign
Imports.None)
]
listAligns :: [([Char], ListAlign)]
listAligns =
[ ([Char]
"new_line", ListAlign
Imports.NewLine)
, ([Char]
"with_module_name", ListAlign
Imports.WithModuleName)
, ([Char]
"with_alias", ListAlign
Imports.WithAlias)
, ([Char]
"after_alias", ListAlign
Imports.AfterAlias)
, ([Char]
"repeat", ListAlign
Imports.Repeat)
]
longListAligns :: [([Char], LongListAlign)]
longListAligns =
[ ([Char]
"inline", LongListAlign
Imports.Inline)
, ([Char]
"new_line", LongListAlign
Imports.InlineWithBreak)
, ([Char]
"new_line_multiline", LongListAlign
Imports.InlineToMultiline)
, ([Char]
"multiline", LongListAlign
Imports.Multiline)
]
emptyListAligns :: [([Char], EmptyListAlign)]
emptyListAligns =
[ ([Char]
"inherit", EmptyListAlign
Imports.Inherit)
, ([Char]
"right_after", EmptyListAlign
Imports.RightAfter)
]
parseListPadding :: Value -> Parser ListPadding
parseListPadding = \case
A.String Text
"module_name" -> ListPadding -> Parser ListPadding
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListPadding
Imports.LPModuleName
A.Number Scientific
n | Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
1 -> ListPadding -> Parser ListPadding
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListPadding -> Parser ListPadding)
-> ListPadding -> Parser ListPadding
forall a b. (a -> b) -> a -> b
$ Int -> ListPadding
Imports.LPConstant (Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Scientific
n)
Value
v -> [Char] -> Value -> Parser ListPadding
forall a. [Char] -> Value -> Parser a
A.typeMismatch [Char]
"'module_name' or >=1 number" Value
v
parseLanguagePragmas :: Config -> A.Object -> A.Parser Step
parseLanguagePragmas :: Config -> Object -> Parser Step
parseLanguagePragmas Config
config Object
o = Maybe Int -> Style -> Bool -> Bool -> [Char] -> Step
LanguagePragmas.step
(Maybe Int -> Style -> Bool -> Bool -> [Char] -> Step)
-> Parser (Maybe Int)
-> Parser (Style -> Bool -> Bool -> [Char] -> Step)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Parser (Maybe Int)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Maybe Int
configColumns Config
config)
Parser (Style -> Bool -> Bool -> [Char] -> Step)
-> Parser Style -> Parser (Bool -> Bool -> [Char] -> Step)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"style" Parser (Maybe [Char])
-> (Maybe [Char] -> Parser Style) -> Parser Style
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], Style)] -> Style -> Maybe [Char] -> Parser Style
forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], Style)]
styles Style
LanguagePragmas.Vertical)
Parser (Bool -> Bool -> [Char] -> Step)
-> Parser Bool -> Parser (Bool -> [Char] -> Step)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"align" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
Parser (Bool -> [Char] -> Step)
-> Parser Bool -> Parser ([Char] -> Step)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"remove_redundant" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
Parser ([Char] -> Step) -> Parser [Char] -> Parser Step
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser [Char]
mkLanguage Object
o
where
styles :: [([Char], Style)]
styles =
[ ([Char]
"vertical", Style
LanguagePragmas.Vertical)
, ([Char]
"compact", Style
LanguagePragmas.Compact)
, ([Char]
"compact_line", Style
LanguagePragmas.CompactLine)
, ([Char]
"vertical_compact", Style
LanguagePragmas.VerticalCompact)
]
mkLanguage :: A.Object -> A.Parser String
mkLanguage :: Object -> Parser [Char]
mkLanguage Object
o = do
Maybe [Char]
lang <- Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"language_prefix"
Parser [Char]
-> ([Char] -> Parser [Char]) -> Maybe [Char] -> Parser [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser [Char]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"LANGUAGE") [Char] -> Parser [Char]
validate Maybe [Char]
lang
where
validate :: String -> A.Parser String
validate :: [Char] -> Parser [Char]
validate [Char]
s
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"language" = [Char] -> Parser [Char]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
s
| Bool
otherwise = [Char] -> Parser [Char]
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"please provide a valid language prefix"
parseTabs :: Config -> A.Object -> A.Parser Step
parseTabs :: Config -> Object -> Parser Step
parseTabs Config
_ Object
o = Int -> Step
Tabs.step
(Int -> Step) -> Parser Int -> Parser Step
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"spaces" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Int
8
parseTrailingWhitespace :: Config -> A.Object -> A.Parser Step
parseTrailingWhitespace :: Config -> Object -> Parser Step
parseTrailingWhitespace Config
_ Object
_ = Step -> Parser Step
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
TrailingWhitespace.step
parseUnicodeSyntax :: Config -> A.Object -> A.Parser Step
parseUnicodeSyntax :: Config -> Object -> Parser Step
parseUnicodeSyntax Config
_ Object
o = Bool -> [Char] -> Step
UnicodeSyntax.step
(Bool -> [Char] -> Step) -> Parser Bool -> Parser ([Char] -> Step)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"add_language_pragma" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
Parser ([Char] -> Step) -> Parser [Char] -> Parser Step
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser [Char]
mkLanguage Object
o