{-# 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