-- | This module defines the 'Block' data type.
module CabalGild.Unstable.Type.Block where

import qualified CabalGild.Unstable.Type.Line as Line
import qualified Data.ByteString as ByteString
import qualified Distribution.Compat.Lens as Lens
import Prelude hiding (lines)

-- | A block of text, which is made up of multiple lines and can have blank
-- lines before and/or after it.
data Block = Block
  { -- | Does this block have a blank line before it?
    Block -> Bool
lineBefore :: Bool,
    Block -> [Line]
lines :: [Line.Line],
    -- | Does this block have a blank line after it?
    Block -> Bool
lineAfter :: Bool
  }
  deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show)

-- | Joins two blocks together by adding a blank line between them if
-- necessary. (A blank line is necessary if /either/ block needs a space.) If
-- either block is empty, the other block is returned.
instance Semigroup Block where
  Block
x <> :: Block -> Block -> Block
<> Block
y =
    let s :: [Line]
s = [Line
Line.empty | Block -> Bool
lineAfter Block
x Bool -> Bool -> Bool
|| Block -> Bool
lineBefore Block
y]
        z :: Block
z =
          Block
            { lineBefore :: Bool
lineBefore = Block -> Bool
lineBefore Block
x,
              lines :: [Line]
lines = Block -> [Line]
lines Block
x [Line] -> [Line] -> [Line]
forall a. Semigroup a => a -> a -> a
<> [Line]
s [Line] -> [Line] -> [Line]
forall a. Semigroup a => a -> a -> a
<> Block -> [Line]
lines Block
y,
              lineAfter :: Bool
lineAfter = Block -> Bool
lineAfter Block
y
            }
     in if Block -> Bool
isEmpty Block
x then Block
y else if Block -> Bool
isEmpty Block
y then Block
x else Block
z

-- | The empty block has no lines and also no blank lines before or after.
instance Monoid Block where
  mempty :: Block
mempty =
    Block
      { lineBefore :: Bool
lineBefore = Bool
False,
        lines :: [Line]
lines = [],
        lineAfter :: Bool
lineAfter = Bool
False
      }

-- | Converts a single line into a block without blank lines before or after.
fromLine :: Line.Line -> Block
fromLine :: Line -> Block
fromLine Line
l = Block
forall a. Monoid a => a
mempty {lines = [l]}

-- | Returns 'True' if the block has no lines.
isEmpty :: Block -> Bool
isEmpty :: Block -> Bool
isEmpty = [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Line] -> Bool) -> (Block -> [Line]) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Line]
lines

-- | A lens for the 'lineAfter' field.
lineAfterLens :: Lens.Lens' Block Bool
lineAfterLens :: Lens' Block Bool
lineAfterLens Bool -> f Bool
f Block
s = (Bool -> Block) -> f Bool -> f Block
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a -> Block
s {lineAfter = a}) (f Bool -> f Block) -> (Bool -> f Bool) -> Bool -> f Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> f Bool
f (Bool -> f Block) -> Bool -> f Block
forall a b. (a -> b) -> a -> b
$ Block -> Bool
lineAfter Block
s

-- | A lens for the 'lineBefore' field.
lineBeforeLens :: Lens.Lens' Block Bool
lineBeforeLens :: Lens' Block Bool
lineBeforeLens Bool -> f Bool
f Block
s = (Bool -> Block) -> f Bool -> f Block
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
a -> Block
s {lineBefore = a}) (f Bool -> f Block) -> (Bool -> f Bool) -> Bool -> f Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> f Bool
f (Bool -> f Block) -> Bool -> f Block
forall a b. (a -> b) -> a -> b
$ Block -> Bool
lineBefore Block
s

-- | Converts a block into a 'ByteString.ByteString' by joining the lines
-- together with newline characters. Note that unline 'unlines', there will be
-- no trailing newline unless 'lineAfter' is 'True'.
toByteString :: Block -> ByteString.ByteString
toByteString :: Block -> ByteString
toByteString Block
b =
  if Block -> Bool
isEmpty Block
b
    then ByteString
ByteString.empty
    else
      ByteString -> [ByteString] -> ByteString
ByteString.intercalate (Word8 -> ByteString
ByteString.singleton Word8
0x0a)
        ([ByteString] -> ByteString)
-> ([Line] -> [ByteString]) -> [Line] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> ByteString) -> [Line] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Line -> ByteString
Line.toByteString
        ([Line] -> ByteString) -> [Line] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Line]] -> [Line]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Line
Line.empty | Block -> Bool
lineBefore Block
b],
            Block -> [Line]
lines Block
b,
            [Line
Line.empty | Block -> Bool
lineAfter Block
b]
          ]