{-# LANGUAGE DataKinds #-}

module Krank.Types
  ( GithubKey (..),
    GitlabHost (..),
    GitlabKey (..),
    Violation (..),
    ViolationLevel (..),
    KrankConfig (..),
    SourcePos (..),
    Localized (..),
    MonadKrank (..),
  )
where

import Control.Exception.Safe (MonadCatch)
import Data.Aeson (FromJSON)
import Data.ByteString
import Data.Map (Map)
import Data.Text (Text)
import qualified Network.HTTP.Req as Req

newtype GithubKey = GithubKey Text deriving (Int -> GithubKey -> ShowS
[GithubKey] -> ShowS
GithubKey -> String
(Int -> GithubKey -> ShowS)
-> (GithubKey -> String)
-> ([GithubKey] -> ShowS)
-> Show GithubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GithubKey] -> ShowS
$cshowList :: [GithubKey] -> ShowS
show :: GithubKey -> String
$cshow :: GithubKey -> String
showsPrec :: Int -> GithubKey -> ShowS
$cshowsPrec :: Int -> GithubKey -> ShowS
Show)

newtype GitlabKey = GitlabKey Text deriving (Int -> GitlabKey -> ShowS
[GitlabKey] -> ShowS
GitlabKey -> String
(Int -> GitlabKey -> ShowS)
-> (GitlabKey -> String)
-> ([GitlabKey] -> ShowS)
-> Show GitlabKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitlabKey] -> ShowS
$cshowList :: [GitlabKey] -> ShowS
show :: GitlabKey -> String
$cshow :: GitlabKey -> String
showsPrec :: Int -> GitlabKey -> ShowS
$cshowsPrec :: Int -> GitlabKey -> ShowS
Show)

newtype GitlabHost = GitlabHost Text deriving (Int -> GitlabHost -> ShowS
[GitlabHost] -> ShowS
GitlabHost -> String
(Int -> GitlabHost -> ShowS)
-> (GitlabHost -> String)
-> ([GitlabHost] -> ShowS)
-> Show GitlabHost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitlabHost] -> ShowS
$cshowList :: [GitlabHost] -> ShowS
show :: GitlabHost -> String
$cshow :: GitlabHost -> String
showsPrec :: Int -> GitlabHost -> ShowS
$cshowsPrec :: Int -> GitlabHost -> ShowS
Show, Eq GitlabHost
Eq GitlabHost
-> (GitlabHost -> GitlabHost -> Ordering)
-> (GitlabHost -> GitlabHost -> Bool)
-> (GitlabHost -> GitlabHost -> Bool)
-> (GitlabHost -> GitlabHost -> Bool)
-> (GitlabHost -> GitlabHost -> Bool)
-> (GitlabHost -> GitlabHost -> GitlabHost)
-> (GitlabHost -> GitlabHost -> GitlabHost)
-> Ord GitlabHost
GitlabHost -> GitlabHost -> Bool
GitlabHost -> GitlabHost -> Ordering
GitlabHost -> GitlabHost -> GitlabHost
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GitlabHost -> GitlabHost -> GitlabHost
$cmin :: GitlabHost -> GitlabHost -> GitlabHost
max :: GitlabHost -> GitlabHost -> GitlabHost
$cmax :: GitlabHost -> GitlabHost -> GitlabHost
>= :: GitlabHost -> GitlabHost -> Bool
$c>= :: GitlabHost -> GitlabHost -> Bool
> :: GitlabHost -> GitlabHost -> Bool
$c> :: GitlabHost -> GitlabHost -> Bool
<= :: GitlabHost -> GitlabHost -> Bool
$c<= :: GitlabHost -> GitlabHost -> Bool
< :: GitlabHost -> GitlabHost -> Bool
$c< :: GitlabHost -> GitlabHost -> Bool
compare :: GitlabHost -> GitlabHost -> Ordering
$ccompare :: GitlabHost -> GitlabHost -> Ordering
$cp1Ord :: Eq GitlabHost
Ord, GitlabHost -> GitlabHost -> Bool
(GitlabHost -> GitlabHost -> Bool)
-> (GitlabHost -> GitlabHost -> Bool) -> Eq GitlabHost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitlabHost -> GitlabHost -> Bool
$c/= :: GitlabHost -> GitlabHost -> Bool
== :: GitlabHost -> GitlabHost -> Bool
$c== :: GitlabHost -> GitlabHost -> Bool
Eq)

data ViolationLevel = Info | Warning | Error deriving (Int -> ViolationLevel -> ShowS
[ViolationLevel] -> ShowS
ViolationLevel -> String
(Int -> ViolationLevel -> ShowS)
-> (ViolationLevel -> String)
-> ([ViolationLevel] -> ShowS)
-> Show ViolationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViolationLevel] -> ShowS
$cshowList :: [ViolationLevel] -> ShowS
show :: ViolationLevel -> String
$cshow :: ViolationLevel -> String
showsPrec :: Int -> ViolationLevel -> ShowS
$cshowsPrec :: Int -> ViolationLevel -> ShowS
Show)

data SourcePos
  = SourcePos
      { SourcePos -> String
file :: FilePath,
        SourcePos -> Int
lineNumber :: Int,
        SourcePos -> Int
colNumber :: Int
      }
  deriving (Int -> SourcePos -> ShowS
[SourcePos] -> ShowS
SourcePos -> String
(Int -> SourcePos -> ShowS)
-> (SourcePos -> String)
-> ([SourcePos] -> ShowS)
-> Show SourcePos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourcePos] -> ShowS
$cshowList :: [SourcePos] -> ShowS
show :: SourcePos -> String
$cshow :: SourcePos -> String
showsPrec :: Int -> SourcePos -> ShowS
$cshowsPrec :: Int -> SourcePos -> ShowS
Show, SourcePos -> SourcePos -> Bool
(SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool) -> Eq SourcePos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePos -> SourcePos -> Bool
$c/= :: SourcePos -> SourcePos -> Bool
== :: SourcePos -> SourcePos -> Bool
$c== :: SourcePos -> SourcePos -> Bool
Eq, Eq SourcePos
Eq SourcePos
-> (SourcePos -> SourcePos -> Ordering)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> SourcePos)
-> (SourcePos -> SourcePos -> SourcePos)
-> Ord SourcePos
SourcePos -> SourcePos -> Bool
SourcePos -> SourcePos -> Ordering
SourcePos -> SourcePos -> SourcePos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourcePos -> SourcePos -> SourcePos
$cmin :: SourcePos -> SourcePos -> SourcePos
max :: SourcePos -> SourcePos -> SourcePos
$cmax :: SourcePos -> SourcePos -> SourcePos
>= :: SourcePos -> SourcePos -> Bool
$c>= :: SourcePos -> SourcePos -> Bool
> :: SourcePos -> SourcePos -> Bool
$c> :: SourcePos -> SourcePos -> Bool
<= :: SourcePos -> SourcePos -> Bool
$c<= :: SourcePos -> SourcePos -> Bool
< :: SourcePos -> SourcePos -> Bool
$c< :: SourcePos -> SourcePos -> Bool
compare :: SourcePos -> SourcePos -> Ordering
$ccompare :: SourcePos -> SourcePos -> Ordering
$cp1Ord :: Eq SourcePos
Ord)

-- | Represents a localized chunk of information
-- in a file
data Localized t
  = Localized
      { Localized t -> SourcePos
getLocation :: SourcePos,
        Localized t -> t
unLocalized :: t
      }
  deriving (Int -> Localized t -> ShowS
[Localized t] -> ShowS
Localized t -> String
(Int -> Localized t -> ShowS)
-> (Localized t -> String)
-> ([Localized t] -> ShowS)
-> Show (Localized t)
forall t. Show t => Int -> Localized t -> ShowS
forall t. Show t => [Localized t] -> ShowS
forall t. Show t => Localized t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Localized t] -> ShowS
$cshowList :: forall t. Show t => [Localized t] -> ShowS
show :: Localized t -> String
$cshow :: forall t. Show t => Localized t -> String
showsPrec :: Int -> Localized t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Localized t -> ShowS
Show, Localized t -> Localized t -> Bool
(Localized t -> Localized t -> Bool)
-> (Localized t -> Localized t -> Bool) -> Eq (Localized t)
forall t. Eq t => Localized t -> Localized t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Localized t -> Localized t -> Bool
$c/= :: forall t. Eq t => Localized t -> Localized t -> Bool
== :: Localized t -> Localized t -> Bool
$c== :: forall t. Eq t => Localized t -> Localized t -> Bool
Eq)

data Violation
  = Violation
      { -- | A textual representation of the checker. Most of the time that's
        -- the chunck of text parsed
        Violation -> Text
checker :: Text,
        -- | The 'ViolationLevel' associated with the result
        Violation -> ViolationLevel
level :: ViolationLevel,
        -- | A message describing the error
        Violation -> Text
message :: Text,
        -- | The position in the input sources of the chunck
        Violation -> SourcePos
location :: SourcePos
      }
  deriving (Int -> Violation -> ShowS
[Violation] -> ShowS
Violation -> String
(Int -> Violation -> ShowS)
-> (Violation -> String)
-> ([Violation] -> ShowS)
-> Show Violation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Violation] -> ShowS
$cshowList :: [Violation] -> ShowS
show :: Violation -> String
$cshow :: Violation -> String
showsPrec :: Int -> Violation -> ShowS
$cshowsPrec :: Int -> Violation -> ShowS
Show)

data KrankConfig
  = KrankConfig
      { -- | The github oAuth token
        KrankConfig -> Maybe GithubKey
githubKey :: Maybe GithubKey,
        -- | The gitlab oAuth token
        KrankConfig -> Map GitlabHost GitlabKey
gitlabKeys :: Map GitlabHost GitlabKey,
        -- | If 'True', all IO operations, such as HTTP requests, are ignored
        KrankConfig -> Bool
dryRun :: Bool,
        -- | Use color for formatting
        KrankConfig -> Bool
useColors :: Bool
      }
  deriving (Int -> KrankConfig -> ShowS
[KrankConfig] -> ShowS
KrankConfig -> String
(Int -> KrankConfig -> ShowS)
-> (KrankConfig -> String)
-> ([KrankConfig] -> ShowS)
-> Show KrankConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KrankConfig] -> ShowS
$cshowList :: [KrankConfig] -> ShowS
show :: KrankConfig -> String
$cshow :: KrankConfig -> String
showsPrec :: Int -> KrankConfig -> ShowS
$cshowsPrec :: Int -> KrankConfig -> ShowS
Show)

-- | This monad represents all the effect that Krank needs
class (Monad m, MonadCatch m) => MonadKrank m where
  -- | Run a REST requet
  krankRunRESTRequest :: FromJSON t => Req.Url 'Req.Https -> Req.Option 'Req.Https -> m t

  -- | Read the configuration
  krankAsks :: (KrankConfig -> b) -> m b

  -- * Concurrency

  -- | Apply a function on many item in a concurrent way
  krankMapConcurrently :: (a -> m b) -> [a] -> m [b]

  krankForConcurrently :: [a] -> (a -> m b) -> m [b]
  krankForConcurrently = ((a -> m b) -> [a] -> m [b]) -> [a] -> (a -> m b) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> [a] -> m [b]
forall (m :: * -> *) a b.
MonadKrank m =>
(a -> m b) -> [a] -> m [b]
krankMapConcurrently

  -- * IO Part

  -- | Read a file from filesystem
  krankReadFile :: FilePath -> m ByteString

  -- | Log an error (with trailing \n)
  krankPutStrLnStderr :: Text -> m ()

  -- | Log a message (without trailing \n)
  krankPutStr :: Text -> m ()