--------------------------------------------------------------------------------
{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
$c/= :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
== :: ExitCodeBehavior -> ExitCodeBehavior -> Bool
$c== :: 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) = forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a b. (a -> b) -> a -> b
$
        [[Char]
d [Char] -> ShowS
</> [Char]
configFileName | [Char]
d <- [Char] -> [[Char]]
ancestors [Char]
current] 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
_ []             = forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ [Char]
f forall a. [a] -> [a] -> [a]
++ if Bool
exists then [Char]
" exists" else [Char]
" does not exist"
    if Bool
exists then forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a b. (a -> b) -> a -> b
$ [Char]
"Loading configuration at " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe [Char]
"<embedded>" Maybe [Char]
mbFp
    ByteString
bytes <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
defaultConfigBytes) [Char] -> IO ByteString
B.readFile Maybe [Char]
mbFp
    case forall v. FromJSON v => ByteString -> Either (Pos, [Char]) v
decode1Strict ByteString
bytes of
        Left (Pos
pos, [Char]
err)     -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Pos -> ByteString -> ShowS
prettyPosWithSource Pos
pos (ByteString -> ByteString
fromStrict ByteString
bytes) ([Char]
"Language.Haskell.Stylish.Config.loadConfig: " forall a. [a] -> [a] -> [a]
++ [Char]
err)
        Right Config
config -> do
          [[Char]]
cabalLanguageExtensions <- if Config -> Bool
configCabal Config
config
            then forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, Bool) -> [Char]
toStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbose -> IO [(KnownExtension, Bool)]
Cabal.findLanguageExtensions Verbose
verbose
            else forall (f :: * -> *) a. Applicative f => a -> f a
pure []

          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
config
            { configLanguageExtensions :: [[Char]]
configLanguageExtensions = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$
                Config -> [[Char]]
configLanguageExtensions Config
config forall a. [a] -> [a] -> [a]
++ [[Char]]
cabalLanguageExtensions
            }
    where toStr :: (a, Bool) -> [Char]
toStr (a
ext, Bool
True)  = forall a. Show a => a -> [Char]
show a
ext
          toStr (a
ext, Bool
False) = [Char]
"No" forall a. [a] -> [a] -> [a]
++ 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
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:! Key
"columns"             forall a. Parser (Maybe a) -> a -> Parser a
A..!= forall a. a -> Maybe a
Just Int
80)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"language_extensions" forall a. Parser (Maybe a) -> a -> Parser a
A..!= [])
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"newline"             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], Newline)]
newlines Newline
IO.nativeNewline)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"cabal"               forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"exit_code"           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"steps" :: A.Parser [A.Value]
    [[Step]]
steps      <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Config -> Value -> Parser [Step]
parseSteps Config
config) [Value]
stepValues
    forall (m :: * -> *) a. Monad m => a -> m a
return Config
config {configSteps :: [Step]
configSteps = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Step]]
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
_            = 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 = 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' <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
val :: A.Parser (Map String A.Value)
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
M.toList Map [Char] Value
map') forall a b. (a -> b) -> a -> b
$ \([Char]
k, Value
v) -> case (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)
_                         -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid declaration for " 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  = forall (m :: * -> *) a. Monad m => a -> m a
return a
def
parseEnum [([Char], a)]
strs a
_   (Just [Char]
k) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
k [([Char], a)]
strs of
    Just a
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown option: " forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
", should be one of: " forall a. [a] -> [a] -> [a]
++
        forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> Config -> Step
ModuleHeader.step Maybe Int
columns) forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Bool -> BreakWhere -> OpenBracket -> Config
ModuleHeader.Config
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"indent"         forall a. Parser (Maybe a) -> a -> Parser a
A..!= Config -> Int
ModuleHeader.indent        Config
def)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"sort"           forall a. Parser (Maybe a) -> a -> Parser a
A..!= Config -> Bool
ModuleHeader.sort          Config
def)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"separate_lists" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Config -> Bool
ModuleHeader.separateLists Config
def)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"break_where"      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], BreakWhere)]
breakWhere (Config -> BreakWhere
ModuleHeader.breakWhere Config
def))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"open_bracket"     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Maybe Int
configColumns Config
c)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Align -> Align -> Align -> Align -> Config
SimpleAlign.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
        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
        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
        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 forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], Align)]
aligns (Config -> Align
f Config
SimpleAlign.defaultConfig)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Bool -> Align
boolToAlign forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o 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
    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
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"equals" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Indent
parseIndent)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"first_field" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Indent
parseIndent)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"field_comment")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"deriving")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"break_enums" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"break_single_constructors" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"via" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Indent
parseIndent)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"curried_context" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"sort_deriving" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure MaxColumns
configMaxColumns)
  where
    configMaxColumns :: MaxColumns
configMaxColumns =
      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" -> 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 forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
7 Text
t) of
             Just Int
n  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Indent
Data.Indent Int
n
             Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Indent: not a number" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Int -> Text -> Text
T.drop Int
7 Text
t)
    A.String Text
t -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"can't parse indent setting: " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
t
    Value
_ -> 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
_ = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> Options -> Step
Imports.step Maybe Int
columns) forall a b. (a -> b) -> a -> b
$ ImportAlign
-> ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Bool
-> [GroupRule]
-> Options
Imports.Options
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"align" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], ImportAlign)]
aligns (forall {t}. (Options -> t) -> t
def Options -> ImportAlign
Imports.importAlign))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"list_align" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], ListAlign)]
listAligns (forall {t}. (Options -> t) -> t
def Options -> ListAlign
Imports.listAlign))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"pad_module_names" forall a. Parser (Maybe a) -> a -> Parser a
A..!= forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.padModuleNames)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"long_list_align" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], LongListAlign)]
longListAligns (forall {t}. (Options -> t) -> t
def Options -> LongListAlign
Imports.longListAlign))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"empty_list_align" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], EmptyListAlign)]
emptyListAligns (forall {t}. (Options -> t) -> t
def Options -> EmptyListAlign
Imports.emptyListAlign))
      -- Note that padding has to be at least 1. Default is 4.
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"list_padding" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {t}. (Options -> t) -> t
def Options -> ListPadding
Imports.listPadding) Value -> Parser ListPadding
parseListPadding)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"separate_lists" forall a. Parser (Maybe a) -> a -> Parser a
A..!= forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.separateLists
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"space_surround" forall a. Parser (Maybe a) -> a -> Parser a
A..!= forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.spaceSurround
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"post_qualify" forall a. Parser (Maybe a) -> a -> Parser a
A..!= forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.postQualified
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"group_imports" forall a. Parser (Maybe a) -> a -> Parser a
A..!= forall {t}. (Options -> t) -> t
def Options -> Bool
Imports.groupImports
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"group_rules" forall a. Parser (Maybe a) -> a -> Parser a
A..!= 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" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ListPadding
Imports.LPModuleName
        A.Number Scientific
n | Scientific
n forall a. Ord a => a -> a -> Bool
>= Scientific
1    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> ListPadding
Imports.LPConstant (forall a b. (RealFrac a, Integral b) => a -> b
truncate Scientific
n)
        Value
v                      -> 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Maybe Int
configColumns Config
config)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"style" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [([Char], a)] -> a -> Maybe [Char] -> Parser a
parseEnum [([Char], Style)]
styles Style
LanguagePragmas.Vertical)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"align"            forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"remove_redundant" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
    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 forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"language_prefix"
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
            | forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"language" = forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
s
            | Bool
otherwise = 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"spaces" 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
_ = 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"add_language_pragma" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser [Char]
mkLanguage Object
o