------------------------------------------------------------------------------
-- |
-- Module      : Redact.Types
-- Description : types representing redacted text
-- Copyright   : Copyright (c) 2020-2023 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

module Redact.Types
  ( -- * Line
    Line(..)
    -- * Part
  , Part(..)
    -- * Error
  , Error(..)
  ) where

-- https://hackage.haskell.org/package/text
import Data.Text (Text)

------------------------------------------------------------------------------
-- $Line

-- | Lines of redacted text
--
-- @since 0.4.0.0
data Line
  = NormalLine ![Part]  -- ^ normal line of text
  | RedactLine !Text    -- ^ fully-redacted line of text
  deriving (Line -> Line -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

------------------------------------------------------------------------------
-- $Part

-- | Parts of a normal line
--
-- @since 0.4.0.0
data Part
  = Stet   !Text  -- ^ text intended to be displayed as-is
  | Redact !Text  -- ^ text intended to be made unreadable
  deriving (Part -> Part -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Part -> Part -> Bool
$c/= :: Part -> Part -> Bool
== :: Part -> Part -> Bool
$c== :: Part -> Part -> Bool
Eq, Int -> Part -> ShowS
[Part] -> ShowS
Part -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Part] -> ShowS
$cshowList :: [Part] -> ShowS
show :: Part -> String
$cshow :: Part -> String
showsPrec :: Int -> Part -> ShowS
$cshowsPrec :: Int -> Part -> ShowS
Show)

------------------------------------------------------------------------------
-- $Error

-- | Error sum type
--
-- @since 0.4.0.0
data Error
  = IOError     !IOError  -- ^ I/O error
  | RedactError !String   -- ^ redact parsing error
  deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)