{-# LANGUAGE LambdaCase #-}

module Restyler.Config.Restyler
    ( RestylerOverride
    , overrideRestylers
    )
where

import Restyler.Prelude

import Data.Aeson hiding (Result(..))
import Data.Aeson.Casing
import Data.Aeson.Types (Parser, modifyFailure)
import qualified Data.HashMap.Lazy as HM
import Data.Validation
import Restyler.Config.ExpectedKeys
import Restyler.Config.Include
import Restyler.Config.Interpreter
import Restyler.Config.SketchyList
import Restyler.Delimited
import Restyler.Restyler

data RestylerOverride = RestylerOverride
    { RestylerOverride -> String
roName :: String
    , RestylerOverride -> Maybe Bool
roEnabled :: Maybe Bool
    , RestylerOverride -> Maybe String
roImage :: Maybe String
    , RestylerOverride -> Maybe (SketchyList String)
roCommand :: Maybe (SketchyList String)
    , RestylerOverride -> Maybe (SketchyList String)
roArguments :: Maybe (SketchyList String)
    , RestylerOverride -> Maybe (SketchyList Include)
roInclude :: Maybe (SketchyList Include)
    , RestylerOverride -> Maybe (SketchyList Interpreter)
roInterpreters :: Maybe (SketchyList Interpreter)
    , RestylerOverride -> Maybe Delimiters
roDelimiters :: Maybe Delimiters
    }
    deriving (RestylerOverride -> RestylerOverride -> Bool
(RestylerOverride -> RestylerOverride -> Bool)
-> (RestylerOverride -> RestylerOverride -> Bool)
-> Eq RestylerOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestylerOverride -> RestylerOverride -> Bool
$c/= :: RestylerOverride -> RestylerOverride -> Bool
== :: RestylerOverride -> RestylerOverride -> Bool
$c== :: RestylerOverride -> RestylerOverride -> Bool
Eq, Int -> RestylerOverride -> ShowS
[RestylerOverride] -> ShowS
RestylerOverride -> String
(Int -> RestylerOverride -> ShowS)
-> (RestylerOverride -> String)
-> ([RestylerOverride] -> ShowS)
-> Show RestylerOverride
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestylerOverride] -> ShowS
$cshowList :: [RestylerOverride] -> ShowS
show :: RestylerOverride -> String
$cshow :: RestylerOverride -> String
showsPrec :: Int -> RestylerOverride -> ShowS
$cshowsPrec :: Int -> RestylerOverride -> ShowS
Show, (forall x. RestylerOverride -> Rep RestylerOverride x)
-> (forall x. Rep RestylerOverride x -> RestylerOverride)
-> Generic RestylerOverride
forall x. Rep RestylerOverride x -> RestylerOverride
forall x. RestylerOverride -> Rep RestylerOverride x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RestylerOverride x -> RestylerOverride
$cfrom :: forall x. RestylerOverride -> Rep RestylerOverride x
Generic)

instance FromJSON RestylerOverride where
    parseJSON :: Value -> Parser RestylerOverride
parseJSON = \case
        String name :: Text
name -> Text -> HashMap Text Value -> Parser RestylerOverride
namedOverride Text
name HashMap Text Value
forall k v. HashMap k v
HM.empty
        Object o :: HashMap Text Value
o | [(name :: Text
name, Object o' :: HashMap Text Value
o')] <- HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Value
o -> Text -> HashMap Text Value -> Parser RestylerOverride
namedOverride Text
name HashMap Text Value
o'
        v :: Value
v -> Parser RestylerOverride -> Parser RestylerOverride
forall a. Parser a -> Parser a
suffixIncorrectIndentation
            (Parser RestylerOverride -> Parser RestylerOverride)
-> Parser RestylerOverride -> Parser RestylerOverride
forall a b. (a -> b) -> a -> b
$ Options -> Value -> Parser RestylerOverride
forall a.
(Generic a, GFromJSON Zero (Rep a), Selectors (Rep a)) =>
Options -> Value -> Parser a
genericParseJSONValidated (ShowS -> Options
aesonPrefix ShowS
snakeCase) Value
v

namedOverride :: Text -> HashMap Text Value -> Parser RestylerOverride
namedOverride :: Text -> HashMap Text Value -> Parser RestylerOverride
namedOverride name :: Text
name =
    Value -> Parser RestylerOverride
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser RestylerOverride)
-> (HashMap Text Value -> Value)
-> HashMap Text Value
-> Parser RestylerOverride
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> Value
Object (HashMap Text Value -> Value)
-> (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> HashMap Text Value -> HashMap Text Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insertIfMissing "name" (Text -> Value
String Text
name) (HashMap Text Value -> HashMap Text Value)
-> (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value
-> HashMap Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HashMap Text Value -> HashMap Text Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
name

suffixIncorrectIndentation :: Parser a -> Parser a
suffixIncorrectIndentation :: Parser a -> Parser a
suffixIncorrectIndentation = ShowS -> Parser a -> Parser a
forall a. ShowS -> Parser a -> Parser a
modifyFailure (String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg)
    where msg :: String
msg = "\n\nDo you have incorrect indentation for a named override?"

overrideRestylers
    :: [Restyler] -> [RestylerOverride] -> Either [String] [Restyler]
overrideRestylers :: [Restyler] -> [RestylerOverride] -> Either [String] [Restyler]
overrideRestylers restylers :: [Restyler]
restylers overrides :: [RestylerOverride]
overrides =
    Validation [String] [Restyler] -> Either [String] [Restyler]
forall e a. Validation e a -> Either e a
toEither (Validation [String] [Restyler] -> Either [String] [Restyler])
-> Validation [String] [Restyler] -> Either [String] [Restyler]
forall a b. (a -> b) -> a -> b
$ case [RestylerOverride] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RestylerOverride] -> Int) -> [RestylerOverride] -> Int
forall a b. (a -> b) -> a -> b
$ (RestylerOverride -> Bool)
-> [RestylerOverride] -> [RestylerOverride]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "*") (String -> Bool)
-> (RestylerOverride -> String) -> RestylerOverride -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestylerOverride -> String
roName) [RestylerOverride]
overrides of
        0 -> [Override] -> [Restyler]
explicits ([Override] -> [Restyler])
-> Validation [String] [Override] -> Validation [String] [Restyler]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation [String] [Override]
getOverrides
        1 -> [Restyler] -> [Override] -> [Restyler]
replaced [Restyler]
restylers ([Override] -> [Restyler])
-> Validation [String] [Override] -> Validation [String] [Restyler]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation [String] [Override]
getOverrides
        n :: Int
n -> [String] -> Validation [String] [Restyler]
forall err a. err -> Validation err a
Failure
            [ "You may have at most 1 wildcard in restylers ("
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " found)"
            ]
  where
    getOverrides :: Validation [String] [Override]
getOverrides = (RestylerOverride -> Validation [String] Override)
-> [RestylerOverride] -> Validation [String] [Override]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (HashMap String Restyler
-> RestylerOverride -> Validation [String] Override
overrideRestyler HashMap String Restyler
restylersMap) [RestylerOverride]
overrides

    restylersMap :: HashMap String Restyler
    restylersMap :: HashMap String Restyler
restylersMap = [(String, Restyler)] -> HashMap String Restyler
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Restyler)] -> HashMap String Restyler)
-> [(String, Restyler)] -> HashMap String Restyler
forall a b. (a -> b) -> a -> b
$ (Restyler -> (String, Restyler))
-> [Restyler] -> [(String, Restyler)]
forall a b. (a -> b) -> [a] -> [b]
map (Restyler -> String
rName (Restyler -> String)
-> (Restyler -> Restyler) -> Restyler -> (String, Restyler)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Restyler -> Restyler
forall a. a -> a
id) [Restyler]
restylers

data Override = Explicit Restyler | Wildcard

explicits :: [Override] -> [Restyler]
explicits :: [Override] -> [Restyler]
explicits = (Override -> [Restyler]) -> [Override] -> [Restyler]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Override -> [Restyler]) -> [Override] -> [Restyler])
-> (Override -> [Restyler]) -> [Override] -> [Restyler]
forall a b. (a -> b) -> a -> b
$ \case
    Explicit r :: Restyler
r -> [Restyler
r]
    Wildcard -> []

replaced :: [Restyler] -> [Override] -> [Restyler]
replaced :: [Restyler] -> [Override] -> [Restyler]
replaced restylers :: [Restyler]
restylers overrides :: [Override]
overrides = [Restyler] -> [Override] -> [Restyler]
replaceWildcards [Restyler]
others [Override]
overrides
  where
    others :: [Restyler]
others = (Restyler -> Bool) -> [Restyler] -> [Restyler]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
overriden) (String -> Bool) -> (Restyler -> String) -> Restyler -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Restyler -> String
rName) [Restyler]
restylers
    overriden :: [String]
overriden = (Restyler -> String) -> [Restyler] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Restyler -> String
rName ([Restyler] -> [String]) -> [Restyler] -> [String]
forall a b. (a -> b) -> a -> b
$ [Override] -> [Restyler]
explicits [Override]
overrides

replaceWildcards :: [Restyler] -> [Override] -> [Restyler]
replaceWildcards :: [Restyler] -> [Override] -> [Restyler]
replaceWildcards restylers :: [Restyler]
restylers = (Override -> [Restyler]) -> [Override] -> [Restyler]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Override -> [Restyler]) -> [Override] -> [Restyler])
-> (Override -> [Restyler]) -> [Override] -> [Restyler]
forall a b. (a -> b) -> a -> b
$ \case
    Explicit r :: Restyler
r -> [Restyler
r]
    Wildcard -> [Restyler]
restylers

overrideRestyler
    :: HashMap String Restyler
    -> RestylerOverride
    -> Validation [String] Override
overrideRestyler :: HashMap String Restyler
-> RestylerOverride -> Validation [String] Override
overrideRestyler restylers :: HashMap String Restyler
restylers RestylerOverride {..}
    | String
roName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "*" = Override -> Validation [String] Override
forall (f :: * -> *) a. Applicative f => a -> f a
pure Override
Wildcard
    | Bool
otherwise = Restyler -> Override
Explicit (Restyler -> Override)
-> (Restyler -> Restyler) -> Restyler -> Override
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Restyler -> Restyler
override (Restyler -> Override)
-> Validation [String] Restyler -> Validation [String] Override
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation [String] Restyler
defaults
  where
    defaults :: Validation [String] Restyler
defaults = String
-> HashMap String Restyler
-> String
-> Validation [String] Restyler
forall v.
String -> HashMap String v -> String -> Validation [String] v
lookupExpectedKeyBy "Restyler name" HashMap String Restyler
restylers String
roName
    override :: Restyler -> Restyler
override restyler :: Restyler
restyler@Restyler {..} = Restyler
restyler
        { rEnabled :: Bool
rEnabled = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
roEnabled
        , rImage :: String
rImage = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
rImage Maybe String
roImage
        , rCommand :: [String]
rCommand = [String]
-> (SketchyList String -> [String])
-> Maybe (SketchyList String)
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
rCommand SketchyList String -> [String]
forall a. SketchyList a -> [a]
unSketchy Maybe (SketchyList String)
roCommand
        , rArguments :: [String]
rArguments = [String]
-> (SketchyList String -> [String])
-> Maybe (SketchyList String)
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
rArguments SketchyList String -> [String]
forall a. SketchyList a -> [a]
unSketchy Maybe (SketchyList String)
roArguments
        , rInclude :: [Include]
rInclude = [Include]
-> (SketchyList Include -> [Include])
-> Maybe (SketchyList Include)
-> [Include]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Include]
rInclude SketchyList Include -> [Include]
forall a. SketchyList a -> [a]
unSketchy Maybe (SketchyList Include)
roInclude
        , rInterpreters :: [Interpreter]
rInterpreters = [Interpreter]
-> (SketchyList Interpreter -> [Interpreter])
-> Maybe (SketchyList Interpreter)
-> [Interpreter]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Interpreter]
rInterpreters SketchyList Interpreter -> [Interpreter]
forall a. SketchyList a -> [a]
unSketchy Maybe (SketchyList Interpreter)
roInterpreters
        , rDelimiters :: Maybe Delimiters
rDelimiters = Maybe Delimiters
roDelimiters Maybe Delimiters -> Maybe Delimiters -> Maybe Delimiters
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Delimiters
rDelimiters
        }

lookupExpectedKeyBy
    :: String -> HashMap String v -> String -> Validation [String] v
lookupExpectedKeyBy :: String -> HashMap String v -> String -> Validation [String] v
lookupExpectedKeyBy label :: String
label hm :: HashMap String v
hm k :: String
k =
    case String
-> ((String, v) -> String)
-> [(String, v)]
-> String
-> Either String (String, v)
forall a.
String -> (a -> String) -> [a] -> String -> Either String a
validateExpectedKeyBy String
label (String, v) -> String
forall a b. (a, b) -> a
fst (HashMap String v -> [(String, v)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap String v
hm) String
k of
        Left e :: String
e -> [String] -> Validation [String] v
forall err a. err -> Validation err a
Failure [String
e]
        Right (_k :: String
_k, v :: v
v) -> v -> Validation [String] v
forall err a. a -> Validation err a
Success v
v