--------------------------------------------------------------------------------
{-# 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
    -- TODO Maybe catch an error here, dir might be unreadable
    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
    -- First load the config without the actual steps
    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)

    -- Then fill in the steps based on the partial config we already have
    [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


--------------------------------------------------------------------------------
-- | Utility for enum-like options
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
parseModuleHeader :: Config -> Object -> Parser Step
parseModuleHeader 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))
      -- Note that padding has to be at least 1. Default is 4.
      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)
        ]


--------------------------------------------------------------------------------
-- | Utilities for validating language prefixes
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