{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Ormolu.Config.Types
  ( ImportGroup (..),
    ImportGroupRule (..),
    ImportModuleMatcher (..),
    ImportRulePriority (..),
    matchAllRulePriority,
    matchLocalRulePriority,
    defaultImportRulePriority,
    QualifiedImportMatcher (..),
  )
where

import Control.Applicative (Alternative (..), asum)
import Data.Aeson ((.!=), (.:), (.:?))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.List.NonEmpty (NonEmpty)
import Data.Word (Word8)
import Ormolu.Utils.Glob (Glob, mkGlob)

data ImportGroup = ImportGroup
  { ImportGroup -> Maybe String
igName :: !(Maybe String),
    ImportGroup -> NonEmpty ImportGroupRule
igRules :: !(NonEmpty ImportGroupRule)
  }
  deriving (ImportGroup -> ImportGroup -> Bool
(ImportGroup -> ImportGroup -> Bool)
-> (ImportGroup -> ImportGroup -> Bool) -> Eq ImportGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportGroup -> ImportGroup -> Bool
== :: ImportGroup -> ImportGroup -> Bool
$c/= :: ImportGroup -> ImportGroup -> Bool
/= :: ImportGroup -> ImportGroup -> Bool
Eq, Int -> ImportGroup -> ShowS
[ImportGroup] -> ShowS
ImportGroup -> String
(Int -> ImportGroup -> ShowS)
-> (ImportGroup -> String)
-> ([ImportGroup] -> ShowS)
-> Show ImportGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportGroup -> ShowS
showsPrec :: Int -> ImportGroup -> ShowS
$cshow :: ImportGroup -> String
show :: ImportGroup -> String
$cshowList :: [ImportGroup] -> ShowS
showList :: [ImportGroup] -> ShowS
Show)

instance Aeson.FromJSON ImportGroup where
  parseJSON :: Value -> Parser ImportGroup
parseJSON = String
-> (Object -> Parser ImportGroup) -> Value -> Parser ImportGroup
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ImportGroup" ((Object -> Parser ImportGroup) -> Value -> Parser ImportGroup)
-> (Object -> Parser ImportGroup) -> Value -> Parser ImportGroup
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe String -> NonEmpty ImportGroupRule -> ImportGroup
ImportGroup
      (Maybe String -> NonEmpty ImportGroupRule -> ImportGroup)
-> Parser (Maybe String)
-> Parser (NonEmpty ImportGroupRule -> ImportGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson.parseFieldMaybe Object
o Key
"name"
      Parser (NonEmpty ImportGroupRule -> ImportGroup)
-> Parser (NonEmpty ImportGroupRule) -> Parser ImportGroup
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (NonEmpty ImportGroupRule)
forall a. FromJSON a => Object -> Key -> Parser a
Aeson.parseField Object
o Key
"rules"

data ImportGroupRule = ImportGroupRule
  { ImportGroupRule -> ImportModuleMatcher
igrModuleMatcher :: !ImportModuleMatcher,
    ImportGroupRule -> QualifiedImportMatcher
igrQualifiedMatcher :: !QualifiedImportMatcher,
    ImportGroupRule -> ImportRulePriority
igrPriority :: !ImportRulePriority
  }
  deriving (ImportGroupRule -> ImportGroupRule -> Bool
(ImportGroupRule -> ImportGroupRule -> Bool)
-> (ImportGroupRule -> ImportGroupRule -> Bool)
-> Eq ImportGroupRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportGroupRule -> ImportGroupRule -> Bool
== :: ImportGroupRule -> ImportGroupRule -> Bool
$c/= :: ImportGroupRule -> ImportGroupRule -> Bool
/= :: ImportGroupRule -> ImportGroupRule -> Bool
Eq, Int -> ImportGroupRule -> ShowS
[ImportGroupRule] -> ShowS
ImportGroupRule -> String
(Int -> ImportGroupRule -> ShowS)
-> (ImportGroupRule -> String)
-> ([ImportGroupRule] -> ShowS)
-> Show ImportGroupRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportGroupRule -> ShowS
showsPrec :: Int -> ImportGroupRule -> ShowS
$cshow :: ImportGroupRule -> String
show :: ImportGroupRule -> String
$cshowList :: [ImportGroupRule] -> ShowS
showList :: [ImportGroupRule] -> ShowS
Show)

instance Aeson.FromJSON ImportGroupRule where
  parseJSON :: Value -> Parser ImportGroupRule
parseJSON = String
-> (Object -> Parser ImportGroupRule)
-> Value
-> Parser ImportGroupRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"rule" ((Object -> Parser ImportGroupRule)
 -> Value -> Parser ImportGroupRule)
-> (Object -> Parser ImportGroupRule)
-> Value
-> Parser ImportGroupRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    let parseModuleMatcher :: Parser ImportModuleMatcher
parseModuleMatcher = Value -> Parser ImportModuleMatcher
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
        failUnknownModuleMatcher :: Parser a
failUnknownModuleMatcher = String -> Parser a
forall a. String -> Parser a
Aeson.parseFail String
"Unknown or invalid module matcher"
        attemptParseModuleMatcher :: Parser ImportModuleMatcher
attemptParseModuleMatcher = Parser ImportModuleMatcher
parseModuleMatcher Parser ImportModuleMatcher
-> Parser ImportModuleMatcher -> Parser ImportModuleMatcher
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ImportModuleMatcher
forall {a}. Parser a
failUnknownModuleMatcher
    ImportModuleMatcher
igrModuleMatcher <- Parser ImportModuleMatcher
attemptParseModuleMatcher

    Maybe Bool
qualified <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"qualified"
    QualifiedImportMatcher
igrQualifiedMatcher <- case Maybe Bool
qualified of
      Just Bool
True -> QualifiedImportMatcher -> Parser QualifiedImportMatcher
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QualifiedImportMatcher
MatchQualifiedOnly
      Just Bool
False -> QualifiedImportMatcher -> Parser QualifiedImportMatcher
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QualifiedImportMatcher
MatchUnqualifiedOnly
      Maybe Bool
Nothing -> QualifiedImportMatcher -> Parser QualifiedImportMatcher
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QualifiedImportMatcher
MatchBothQualifiedAndUnqualified

    let defaultPriority :: ImportRulePriority
defaultPriority
          | ImportModuleMatcher
MatchAllModules <- ImportModuleMatcher
igrModuleMatcher = ImportRulePriority
matchAllRulePriority
          | Bool
otherwise = ImportRulePriority
defaultImportRulePriority
    ImportRulePriority
igrPriority <- Object
o Object -> Key -> Parser (Maybe ImportRulePriority)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priority" Parser (Maybe ImportRulePriority)
-> ImportRulePriority -> Parser ImportRulePriority
forall a. Parser (Maybe a) -> a -> Parser a
.!= ImportRulePriority
defaultPriority

    ImportGroupRule -> Parser ImportGroupRule
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportGroupRule {ImportModuleMatcher
QualifiedImportMatcher
ImportRulePriority
igrModuleMatcher :: ImportModuleMatcher
igrQualifiedMatcher :: QualifiedImportMatcher
igrPriority :: ImportRulePriority
igrModuleMatcher :: ImportModuleMatcher
igrQualifiedMatcher :: QualifiedImportMatcher
igrPriority :: ImportRulePriority
..}

newtype ImportRulePriority = ImportRulePriority Word8
  deriving (ImportRulePriority -> ImportRulePriority -> Bool
(ImportRulePriority -> ImportRulePriority -> Bool)
-> (ImportRulePriority -> ImportRulePriority -> Bool)
-> Eq ImportRulePriority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportRulePriority -> ImportRulePriority -> Bool
== :: ImportRulePriority -> ImportRulePriority -> Bool
$c/= :: ImportRulePriority -> ImportRulePriority -> Bool
/= :: ImportRulePriority -> ImportRulePriority -> Bool
Eq, Eq ImportRulePriority
Eq ImportRulePriority =>
(ImportRulePriority -> ImportRulePriority -> Ordering)
-> (ImportRulePriority -> ImportRulePriority -> Bool)
-> (ImportRulePriority -> ImportRulePriority -> Bool)
-> (ImportRulePriority -> ImportRulePriority -> Bool)
-> (ImportRulePriority -> ImportRulePriority -> Bool)
-> (ImportRulePriority -> ImportRulePriority -> ImportRulePriority)
-> (ImportRulePriority -> ImportRulePriority -> ImportRulePriority)
-> Ord ImportRulePriority
ImportRulePriority -> ImportRulePriority -> Bool
ImportRulePriority -> ImportRulePriority -> Ordering
ImportRulePriority -> ImportRulePriority -> ImportRulePriority
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ImportRulePriority -> ImportRulePriority -> Ordering
compare :: ImportRulePriority -> ImportRulePriority -> Ordering
$c< :: ImportRulePriority -> ImportRulePriority -> Bool
< :: ImportRulePriority -> ImportRulePriority -> Bool
$c<= :: ImportRulePriority -> ImportRulePriority -> Bool
<= :: ImportRulePriority -> ImportRulePriority -> Bool
$c> :: ImportRulePriority -> ImportRulePriority -> Bool
> :: ImportRulePriority -> ImportRulePriority -> Bool
$c>= :: ImportRulePriority -> ImportRulePriority -> Bool
>= :: ImportRulePriority -> ImportRulePriority -> Bool
$cmax :: ImportRulePriority -> ImportRulePriority -> ImportRulePriority
max :: ImportRulePriority -> ImportRulePriority -> ImportRulePriority
$cmin :: ImportRulePriority -> ImportRulePriority -> ImportRulePriority
min :: ImportRulePriority -> ImportRulePriority -> ImportRulePriority
Ord, Int -> ImportRulePriority -> ShowS
[ImportRulePriority] -> ShowS
ImportRulePriority -> String
(Int -> ImportRulePriority -> ShowS)
-> (ImportRulePriority -> String)
-> ([ImportRulePriority] -> ShowS)
-> Show ImportRulePriority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportRulePriority -> ShowS
showsPrec :: Int -> ImportRulePriority -> ShowS
$cshow :: ImportRulePriority -> String
show :: ImportRulePriority -> String
$cshowList :: [ImportRulePriority] -> ShowS
showList :: [ImportRulePriority] -> ShowS
Show, ImportRulePriority
ImportRulePriority
-> ImportRulePriority -> Bounded ImportRulePriority
forall a. a -> a -> Bounded a
$cminBound :: ImportRulePriority
minBound :: ImportRulePriority
$cmaxBound :: ImportRulePriority
maxBound :: ImportRulePriority
Bounded)

instance Aeson.FromJSON ImportRulePriority where
  parseJSON :: Value -> Parser ImportRulePriority
parseJSON = (Word8 -> ImportRulePriority)
-> Parser Word8 -> Parser ImportRulePriority
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> ImportRulePriority
ImportRulePriority (Parser Word8 -> Parser ImportRulePriority)
-> (Value -> Parser Word8) -> Value -> Parser ImportRulePriority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Word8
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

matchAllRulePriority :: ImportRulePriority
matchAllRulePriority :: ImportRulePriority
matchAllRulePriority = Word8 -> ImportRulePriority
ImportRulePriority Word8
100

matchLocalRulePriority :: ImportRulePriority
matchLocalRulePriority :: ImportRulePriority
matchLocalRulePriority = Word8 -> ImportRulePriority
ImportRulePriority Word8
60 -- Lower priority than "all" but higher than the default.

defaultImportRulePriority :: ImportRulePriority
defaultImportRulePriority :: ImportRulePriority
defaultImportRulePriority = Word8 -> ImportRulePriority
ImportRulePriority Word8
50

data QualifiedImportMatcher
  = MatchQualifiedOnly
  | MatchUnqualifiedOnly
  | MatchBothQualifiedAndUnqualified
  deriving (QualifiedImportMatcher -> QualifiedImportMatcher -> Bool
(QualifiedImportMatcher -> QualifiedImportMatcher -> Bool)
-> (QualifiedImportMatcher -> QualifiedImportMatcher -> Bool)
-> Eq QualifiedImportMatcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualifiedImportMatcher -> QualifiedImportMatcher -> Bool
== :: QualifiedImportMatcher -> QualifiedImportMatcher -> Bool
$c/= :: QualifiedImportMatcher -> QualifiedImportMatcher -> Bool
/= :: QualifiedImportMatcher -> QualifiedImportMatcher -> Bool
Eq, Int -> QualifiedImportMatcher -> ShowS
[QualifiedImportMatcher] -> ShowS
QualifiedImportMatcher -> String
(Int -> QualifiedImportMatcher -> ShowS)
-> (QualifiedImportMatcher -> String)
-> ([QualifiedImportMatcher] -> ShowS)
-> Show QualifiedImportMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualifiedImportMatcher -> ShowS
showsPrec :: Int -> QualifiedImportMatcher -> ShowS
$cshow :: QualifiedImportMatcher -> String
show :: QualifiedImportMatcher -> String
$cshowList :: [QualifiedImportMatcher] -> ShowS
showList :: [QualifiedImportMatcher] -> ShowS
Show)

data ImportModuleMatcher
  = MatchAllModules
  | MatchLocalModules
  | MatchGlob !Glob
  deriving (ImportModuleMatcher -> ImportModuleMatcher -> Bool
(ImportModuleMatcher -> ImportModuleMatcher -> Bool)
-> (ImportModuleMatcher -> ImportModuleMatcher -> Bool)
-> Eq ImportModuleMatcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportModuleMatcher -> ImportModuleMatcher -> Bool
== :: ImportModuleMatcher -> ImportModuleMatcher -> Bool
$c/= :: ImportModuleMatcher -> ImportModuleMatcher -> Bool
/= :: ImportModuleMatcher -> ImportModuleMatcher -> Bool
Eq, Int -> ImportModuleMatcher -> ShowS
[ImportModuleMatcher] -> ShowS
ImportModuleMatcher -> String
(Int -> ImportModuleMatcher -> ShowS)
-> (ImportModuleMatcher -> String)
-> ([ImportModuleMatcher] -> ShowS)
-> Show ImportModuleMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportModuleMatcher -> ShowS
showsPrec :: Int -> ImportModuleMatcher -> ShowS
$cshow :: ImportModuleMatcher -> String
show :: ImportModuleMatcher -> String
$cshowList :: [ImportModuleMatcher] -> ShowS
showList :: [ImportModuleMatcher] -> ShowS
Show)

instance Aeson.FromJSON ImportModuleMatcher where
  parseJSON :: Value -> Parser ImportModuleMatcher
parseJSON Value
v =
    [Parser ImportModuleMatcher] -> Parser ImportModuleMatcher
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ Value -> Parser ImportModuleMatcher
parseMatchModuleMatcher Value
v,
        Value -> Parser ImportModuleMatcher
parseGlobModuleMatcher Value
v
      ]
    where
      parseMatchModuleMatcher :: Aeson.Value -> Aeson.Parser ImportModuleMatcher
      parseMatchModuleMatcher :: Value -> Parser ImportModuleMatcher
parseMatchModuleMatcher = String
-> (Object -> Parser ImportModuleMatcher)
-> Value
-> Parser ImportModuleMatcher
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ImportModuleMatcher" ((Object -> Parser ImportModuleMatcher)
 -> Value -> Parser ImportModuleMatcher)
-> (Object -> Parser ImportModuleMatcher)
-> Value
-> Parser ImportModuleMatcher
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        String
c <- forall a. FromJSON a => Object -> Key -> Parser a
Aeson.parseField @String Object
o Key
"match"
        case String
c of
          String
"all" -> ImportModuleMatcher -> Parser ImportModuleMatcher
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportModuleMatcher
MatchAllModules
          String
"local-modules" -> ImportModuleMatcher -> Parser ImportModuleMatcher
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportModuleMatcher
MatchLocalModules
          String
other -> String -> Parser ImportModuleMatcher
forall a. String -> Parser a
Aeson.parseFail (String -> Parser ImportModuleMatcher)
-> String -> Parser ImportModuleMatcher
forall a b. (a -> b) -> a -> b
$ String
"Unknown matcher: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
other

      parseGlobModuleMatcher :: Aeson.Value -> Aeson.Parser ImportModuleMatcher
      parseGlobModuleMatcher :: Value -> Parser ImportModuleMatcher
parseGlobModuleMatcher = String
-> (Object -> Parser ImportModuleMatcher)
-> Value
-> Parser ImportModuleMatcher
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ImportModuleMatcher" ((Object -> Parser ImportModuleMatcher)
 -> Value -> Parser ImportModuleMatcher)
-> (Object -> Parser ImportModuleMatcher)
-> Value
-> Parser ImportModuleMatcher
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        String
rawGlob <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"glob"
        let glob :: Glob
glob = String -> Glob
mkGlob String
rawGlob
        ImportModuleMatcher -> Parser ImportModuleMatcher
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Glob -> ImportModuleMatcher
MatchGlob Glob
glob)