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

module Xrefcheck.Util
  ( Field
  , paren
  , postfixFields
  , (-:)
  , aesonConfigOption
  , doesMatchAnyRegex
  , posixTimeToTimeSecond
  , utcTimeToTimeSecond

  , module Xrefcheck.Util.Colorize
  , module Xrefcheck.Util.Interpolate
  ) where

import Universum hiding ((.~))

import Control.Lens (LensRules, lensField, lensRules, mappingNamer, (.~))
import Data.Aeson qualified as Aeson
import Data.Aeson.Casing (aesonPrefix, camelCase)
import Data.Fixed (Fixed (MkFixed), HasResolution (resolution))
import Data.Ratio ((%))
import Data.Time (UTCTime)
import Data.Time.Clock (nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Fmt (Builder)
import Text.Regex.TDFA.Text (Regex, regexec)
import Time (Second, Time (..), sec)

import Xrefcheck.Util.Colorize
import Xrefcheck.Util.Interpolate

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
.~ ([Char] -> [[Char]]) -> FieldNamer
mappingNamer (\[Char]
n -> [[Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"L"])

infixr 0 -:
(-:) :: a -> b -> (a, b)
-: :: forall a b. a -> b -> (a, b)
(-:) = (,)

-- | Options that we use to derive JSON instances for config types.
aesonConfigOption :: Aeson.Options
aesonConfigOption :: Options
aesonConfigOption = (([Char] -> [Char]) -> Options
aesonPrefix [Char] -> [Char]
camelCase){Aeson.rejectUnknownFields = True}

-- | Config fields that may be abscent.
type family Field f a where
  Field Identity a = a
  Field Maybe a = Maybe a

posixTimeToTimeSecond :: POSIXTime -> Time Second
posixTimeToTimeSecond :: POSIXTime -> Time Second
posixTimeToTimeSecond POSIXTime
posixTime =
  let picos :: Pico
picos@(MkFixed Integer
ps) = POSIXTime -> Pico
nominalDiffTimeToSeconds POSIXTime
posixTime
  in RatioNat -> Time Second
sec (RatioNat -> Time Second)
-> (Rational -> RatioNat) -> Rational -> Time Second
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> RatioNat
forall a. Fractional a => Rational -> a
fromRational (Rational -> Time Second) -> Rational -> Time Second
forall a b. (a -> b) -> a -> b
$ Integer
ps Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Pico -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
forall (p :: * -> *). p E12 -> Integer
resolution Pico
picos

utcTimeToTimeSecond :: UTCTime -> Time Second
utcTimeToTimeSecond :: UTCTime -> Time Second
utcTimeToTimeSecond = POSIXTime -> Time Second
POSIXTime -> Time (1 :% 1)
posixTimeToTimeSecond (POSIXTime -> Time (1 :% 1))
-> (UTCTime -> POSIXTime) -> UTCTime -> Time (1 :% 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds

doesMatchAnyRegex :: Text -> ([Regex] -> Bool)
doesMatchAnyRegex :: Text -> [Regex] -> Bool
doesMatchAnyRegex Text
src = (Element [Regex] -> Bool) -> [Regex] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any ((Element [Regex] -> Bool) -> [Regex] -> Bool)
-> (Element [Regex] -> Bool) -> [Regex] -> Bool
forall a b. (a -> b) -> a -> b
$ \Element [Regex]
regex ->
  case Regex -> Text -> Either [Char] (Maybe (Text, Text, Text, [Text]))
regexec Regex
Element [Regex]
regex Text
src of
    Right Maybe (Text, Text, Text, [Text])
res -> case Maybe (Text, Text, Text, [Text])
res of
      Just (Text
before, Text
match, Text
after, [Text]
_) ->
        Text -> Bool
forall t. Container t => t -> Bool
null Text
before Bool -> Bool -> Bool
&& Text -> Bool
forall t. Container t => t -> Bool
null Text
after Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
forall t. Container t => t -> Bool
null Text
match)
      Maybe (Text, Text, Text, [Text])
Nothing -> Bool
False
    Left [Char]
_ -> Bool
False