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

import qualified Data.ByteString as ByteString
import qualified Distribution.Compat.Lens as Lens

-- | A chunk of text, which is made up of a byte string and can have blank
-- spaces before and/or after it.
data Chunk = Chunk
  { -- | Does this chunk have a blank space before it?
    Chunk -> Bool
spaceBefore :: Bool,
    Chunk -> ByteString
value :: ByteString.ByteString,
    -- | Does this chunk have a blank space after it?
    Chunk -> Bool
spaceAfter :: Bool
  }
  deriving (Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
/= :: Chunk -> Chunk -> Bool
Eq, Int -> Chunk -> ShowS
[Chunk] -> ShowS
Chunk -> String
(Int -> Chunk -> ShowS)
-> (Chunk -> String) -> ([Chunk] -> ShowS) -> Show Chunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Chunk -> ShowS
showsPrec :: Int -> Chunk -> ShowS
$cshow :: Chunk -> String
show :: Chunk -> String
$cshowList :: [Chunk] -> ShowS
showList :: [Chunk] -> ShowS
Show)

-- | Joins two chunks together by adding a blank space between them if
-- necessary. (A blank space is necessary if /both/ chunks need a space.) If
-- either chunk is empty, the other chunk is returned.
instance Semigroup Chunk where
  Chunk
x <> :: Chunk -> Chunk -> Chunk
<> Chunk
y =
    let s :: ByteString
s =
          if Chunk -> Bool
spaceAfter Chunk
x Bool -> Bool -> Bool
&& Chunk -> Bool
spaceBefore Chunk
y
            then Word8 -> ByteString
ByteString.singleton Word8
0x20
            else ByteString
ByteString.empty
        z :: Chunk
z =
          Chunk
            { spaceBefore :: Bool
spaceBefore = Chunk -> Bool
spaceBefore Chunk
x,
              value :: ByteString
value = Chunk -> ByteString
value Chunk
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Chunk -> ByteString
value Chunk
y,
              spaceAfter :: Bool
spaceAfter = Chunk -> Bool
spaceAfter Chunk
y
            }
     in if Chunk -> Bool
isEmpty Chunk
x then Chunk
y else if Chunk -> Bool
isEmpty Chunk
y then Chunk
x else Chunk
z

-- | The empty chunk has no value and also no blank spaces before or after.
instance Monoid Chunk where
  mempty :: Chunk
mempty =
    Chunk
      { spaceBefore :: Bool
spaceBefore = Bool
False,
        value :: ByteString
value = ByteString
ByteString.empty,
        spaceAfter :: Bool
spaceAfter = Bool
False
      }

-- | A colon with a space after.
colon :: Chunk
colon :: Chunk
colon = ASetter Chunk Chunk Bool Bool -> Bool -> Chunk -> Chunk
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Chunk Chunk Bool Bool
Lens' Chunk Bool
spaceAfterLens Bool
True (Chunk -> Chunk) -> (ByteString -> Chunk) -> ByteString -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Chunk
fromByteString (ByteString -> Chunk) -> ByteString -> Chunk
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
ByteString.singleton Word8
0x3a

-- | Converts a byte string into a chunk without blank spaces before or after.
fromByteString :: ByteString.ByteString -> Chunk
fromByteString :: ByteString -> Chunk
fromByteString ByteString
bs = Chunk
forall a. Monoid a => a
mempty {value = bs}

-- | Returns 'True' if the chunk's byte string is empty.
isEmpty :: Chunk -> Bool
isEmpty :: Chunk -> Bool
isEmpty = ByteString -> Bool
ByteString.null (ByteString -> Bool) -> (Chunk -> ByteString) -> Chunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> ByteString
value

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

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