{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      : Git.Stale.Core.Internal
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Exports utility functions mainly for parsing/transforming
-- between types/errors.
module Git.Stale.Core.Internal
  ( badBranch,
    exceptToErr,
    parseLog,
    parseAuthDateStr,
    parseDay,
    safeRead,
    stale,
    staleNonErr,
    textToName,
    unsafeToInt,
  )
where

import Common.RefinedUtils
import Control.Monad ((>=>))
import qualified Data.Text as T
import qualified Data.Time.Calendar as C
import Git.Stale.Types.Error
import Git.Types.GitTypes
import qualified Text.Read as TR

-- | Parses `NameLog` into `NameAuthDay`, recording errors
-- as `ErrOr`.
parseLog :: NameLog -> ErrOr NameAuthDay
parseLog :: NameLog -> ErrOr NameAuthDay
parseLog = NameLog -> ErrOr NameAuthDateStr
parseAuthDateStr (NameLog -> ErrOr NameAuthDateStr)
-> (NameAuthDateStr -> ErrOr NameAuthDay)
-> NameLog
-> ErrOr NameAuthDay
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> NameAuthDateStr -> ErrOr NameAuthDay
parseDay

-- | Intermediate parsing of `NameLog` into `NameAuthDateStr`,
-- recording errors as `ErrOr`.
parseAuthDateStr :: NameLog -> ErrOr NameAuthDateStr
parseAuthDateStr :: NameLog -> ErrOr NameAuthDateStr
parseAuthDateStr (n :: Name
n, l :: Text
l) = case Text -> Text -> [Text]
T.splitOn "|" Text
l of
  [a :: Text
a, t :: Text
t] -> NameAuthDateStr -> ErrOr NameAuthDateStr
forall a b. b -> Either a b
Right (Name
n, Text -> Author
Author Text
a, Text
t)
  _ -> Err -> ErrOr NameAuthDateStr
forall a b. a -> Either a b
Left (Err -> ErrOr NameAuthDateStr) -> Err -> ErrOr NameAuthDateStr
forall a b. (a -> b) -> a -> b
$ Text -> Err
ParseLog Text
l

-- | Intermediate parsing of `NameAuthDateStr` into `NameAuthDay`,
-- recording errors as `ErrOr`.
parseDay :: NameAuthDateStr -> ErrOr NameAuthDay
parseDay :: NameAuthDateStr -> ErrOr NameAuthDay
parseDay (n :: Name
n, a :: Author
a, t :: Text
t) = (Day -> NameAuthDay) -> Either Err Day -> ErrOr NameAuthDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name
n,Author
a,) Either Err Day
eitherDay
  where
    eitherDay :: Either Err Day
eitherDay = case (Text -> Either Err Int) -> [Text] -> Either Err [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either Err Int
safeRead (Text -> Text -> [Text]
T.splitOn "-" Text
t) of
      Right [y :: Int
y, m :: Int
m, d :: Int
d] -> Day -> Either Err Day
forall a b. b -> Either a b
Right (Day -> Either Err Day) -> Day -> Either Err Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
C.fromGregorian (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
y) Int
m Int
d
      Right xs :: [Int]
xs -> Err -> Either Err Day
forall a b. a -> Either a b
Left (Err -> Either Err Day) -> Err -> Either Err Day
forall a b. (a -> b) -> a -> b
$ Text -> Err
ParseDate (Text -> Err) -> Text -> Err
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs
      Left x :: Err
x -> Err -> Either Err Day
forall a b. a -> Either a b
Left Err
x

-- | Determines if `NameAuthDay` is stale given by
--
-- > stale lim day (_, _, d) <=> day - d >= lim
stale :: RNonNegative Int -> C.Day -> NameAuthDay -> Bool
stale :: RNonNegative Int -> Day -> NameAuthDay -> Bool
stale lim :: RNonNegative Int
lim day :: Day
day (_, _, d :: Day
d) = Day -> Day -> Integer
C.diffDays Day
day Day
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RNonNegative Int -> Int
forall p x. Refined p x -> x
unrefine RNonNegative Int
lim)

-- | For `Right` `NameAuthDay`, behaves the same as `stale`.
-- But for `Left` `Err` it is always true, since we do not want
-- to filter out errors.
staleNonErr :: RNonNegative Int -> C.Day -> ErrOr NameAuthDay -> Bool
staleNonErr :: RNonNegative Int -> Day -> ErrOr NameAuthDay -> Bool
staleNonErr _ _ (Left _) = Bool
True
staleNonErr i :: RNonNegative Int
i d :: Day
d (Right nad :: NameAuthDay
nad) = RNonNegative Int -> Day -> NameAuthDay -> Bool
stale RNonNegative Int
i Day
d NameAuthDay
nad

-- | Unsafely reads `T.Text` to `Int`.
unsafeToInt :: T.Text -> Int
unsafeToInt :: Text -> Int
unsafeToInt = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Safely reads `T.Text` into `ErrOr` `Int`.
safeRead :: T.Text -> ErrOr Int
safeRead :: Text -> Either Err Int
safeRead t :: Text
t = case String -> Maybe Int
forall a. Read a => String -> Maybe a
TR.readMaybe (Text -> String
T.unpack Text
t) of
  Nothing -> Err -> Either Err Int
forall a b. a -> Either a b
Left (Err -> Either Err Int) -> Err -> Either Err Int
forall a b. (a -> b) -> a -> b
$ Text -> Err
ReadInt Text
t
  Just i :: Int
i -> Int -> Either Err Int
forall a b. b -> Either a b
Right Int
i

-- | Joins nested `Either`s.
exceptToErr :: Show a => Either a (Either Err b) -> Either Err b
exceptToErr :: Either a (Either Err b) -> Either Err b
exceptToErr (Left x :: a
x) = Err -> Either Err b
forall a b. a -> Either a b
Left (Err -> Either Err b) -> Err -> Either Err b
forall a b. (a -> b) -> a -> b
$ Text -> Err
GitLog (Text -> Err) -> Text -> Err
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
x)
exceptToErr (Right r :: Either Err b
r) = Either Err b
r

-- | Tests for bad branches based on presence of /*/ and />/.
badBranch :: T.Text -> Bool
badBranch :: Text -> Bool
badBranch s :: Text
s = (Char -> Bool -> Bool) -> Bool -> String -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> Bool -> Bool
f Bool
False ['*', '>']
  where
    f :: Char -> Bool -> Bool
f badChar :: Char
badChar b :: Bool
b = Bool
b Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
badChar) Text
s

-- | Strips whitespace and potential git prefix (i.e. remotes/).
-- Works for strings with no prefix and those that have the prefix
-- exactly once, e.g.
--
-- > textToName "branch" -> branch
-- > textToName "remotes/origin/branch" -> origin/branch
-- > textToName "blah/remotes/origin/branch" -> origin/branch
--
-- Returns `Left` `ParseName` if the prefix occurs more than once as we
-- have definitely entered undefined territory.
textToName :: T.Text -> ErrOr Name
textToName :: Text -> ErrOr Name
textToName b :: Text
b =
  case Text -> Text -> [Text]
T.splitOn "remotes/" (Text -> Text
T.strip Text
b) of
    [_, nm :: Text
nm] -> Name -> ErrOr Name
forall a b. b -> Either a b
Right (Name -> ErrOr Name) -> Name -> ErrOr Name
forall a b. (a -> b) -> a -> b
$ Text -> Name
Name Text
nm
    [nm :: Text
nm] -> Name -> ErrOr Name
forall a b. b -> Either a b
Right (Name -> ErrOr Name) -> Name -> ErrOr Name
forall a b. (a -> b) -> a -> b
$ Text -> Name
Name Text
nm
    _ -> Err -> ErrOr Name
forall a b. a -> Either a b
Left (Err -> ErrOr Name) -> Err -> ErrOr Name
forall a b. (a -> b) -> a -> b
$ Text -> Err
ParseName Text
b