{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Xrefcheck.Util
    ( nameF'
    , paren
    , postfixFields
    , aesonConfigOption
    ) where

import Control.Lens (LensRules, lensField, lensRules, mappingNamer)
import qualified Data.Aeson as Aeson
import Data.Aeson.Casing (aesonPrefix, camelCase)
import Fmt (Builder, build, fmt, nameF)
import System.Console.Pretty (Pretty (..), Style (Faint))

instance Pretty Builder where
    colorize :: Section -> Color -> Builder -> Builder
colorize Section
s Color
c = Buildable Text => Text -> Builder
forall p. Buildable p => p -> Builder
build @Text (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> Color -> Text -> Text
forall a. Pretty a => Section -> Color -> a -> a
colorize Section
s Color
c (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt
    style :: Style -> Builder -> Builder
style Style
s = Buildable Text => Text -> Builder
forall p. Buildable p => p -> Builder
build @Text (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Text -> Text
forall a. Pretty a => Style -> a -> a
style Style
s (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt

nameF' :: Builder -> Builder -> Builder
nameF' :: Builder -> Builder -> Builder
nameF' Builder
a Builder
b = Builder -> Builder -> Builder
nameF (Style -> Builder -> Builder
forall a. Pretty a => Style -> a -> a
style Style
Faint Builder
a) Builder
b

paren :: Builder -> Builder
paren :: Builder -> Builder
paren Builder
a
    | Builder
a Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
"" = Builder
""
    | Bool
otherwise = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

postfixFields :: LensRules
postfixFields :: LensRules
postfixFields = LensRules
lensRules LensRules -> (LensRules -> LensRules) -> LensRules
forall a b. a -> (a -> b) -> b
& (FieldNamer -> Identity FieldNamer)
-> LensRules -> Identity LensRules
Lens' LensRules FieldNamer
lensField ((FieldNamer -> Identity FieldNamer)
 -> LensRules -> Identity LensRules)
-> FieldNamer -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> [String]) -> FieldNamer
mappingNamer (\String
n -> [String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"L"])

-- | Options that we use to derive JSON instances for config types.
aesonConfigOption :: Aeson.Options
aesonConfigOption :: Options
aesonConfigOption = (String -> String) -> Options
aesonPrefix String -> String
camelCase