module CabalGild.Action.Render where

import qualified CabalGild.Extra.FieldLine as FieldLine
import qualified CabalGild.Extra.Name as Name
import qualified CabalGild.Extra.SectionArg as SectionArg
import qualified CabalGild.Type.Block as Block
import qualified CabalGild.Type.Chunk as Chunk
import qualified CabalGild.Type.Comment as Comment
import qualified CabalGild.Type.Line as Line
import qualified Data.ByteString as ByteString
import qualified Distribution.Compat.Lens as Lens
import qualified Distribution.Fields as Fields

run ::
  (Applicative m) =>
  ([Fields.Field [Comment.Comment a]], [Comment.Comment a]) ->
  m ByteString.ByteString
run :: forall (m :: * -> *) a.
Applicative m =>
([Field [Comment a]], [Comment a]) -> m ByteString
run = ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (([Field [Comment a]], [Comment a]) -> ByteString)
-> ([Field [Comment a]], [Comment a])
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Field [Comment a]] -> [Comment a] -> ByteString)
-> ([Field [Comment a]], [Comment a]) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Field [Comment a]] -> [Comment a] -> ByteString
forall a. [Field [Comment a]] -> [Comment a] -> ByteString
toByteString

toByteString ::
  [Fields.Field [Comment.Comment a]] ->
  [Comment.Comment a] ->
  ByteString.ByteString
toByteString :: forall a. [Field [Comment a]] -> [Comment a] -> ByteString
toByteString [Field [Comment a]]
fs [Comment a]
cs =
  let i :: Int
i = Int
0 :: Int
   in Block -> ByteString
Block.toByteString
        (Block -> ByteString) -> (Block -> Block) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Block Block Bool Bool -> Bool -> Block -> Block
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Block Block Bool Bool
Lens' Block Bool
Block.lineBeforeLens Bool
False
        (Block -> Block) -> (Block -> Block) -> Block -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Block Block Bool Bool -> Bool -> Block -> Block
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Block Block Bool Bool
Lens' Block Bool
Block.lineAfterLens Bool
True
        (Block -> ByteString) -> Block -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Field [Comment a]] -> Block
forall a. Int -> [Field [Comment a]] -> Block
fields Int
i [Field [Comment a]]
fs Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Int -> [Comment a] -> Block
forall a. Int -> [Comment a] -> Block
comments Int
i [Comment a]
cs

fields :: Int -> [Fields.Field [Comment.Comment a]] -> Block.Block
fields :: forall a. Int -> [Field [Comment a]] -> Block
fields = (Field [Comment a] -> Block) -> [Field [Comment a]] -> Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Field [Comment a] -> Block) -> [Field [Comment a]] -> Block)
-> (Int -> Field [Comment a] -> Block)
-> Int
-> [Field [Comment a]]
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Field [Comment a] -> Block
forall a. Int -> Field [Comment a] -> Block
field

field :: Int -> Fields.Field [Comment.Comment a] -> Block.Block
field :: forall a. Int -> Field [Comment a] -> Block
field Int
i Field [Comment a]
f = case Field [Comment a]
f of
  Fields.Field Name [Comment a]
n [FieldLine [Comment a]]
fls -> case [FieldLine [Comment a]]
fls of
    [FieldLine [Comment a]
fl]
      | [Comment a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Comment a] -> Bool) -> [Comment a] -> Bool
forall a b. (a -> b) -> a -> b
$ FieldLine [Comment a] -> [Comment a]
forall a. FieldLine a -> a
FieldLine.annotation FieldLine [Comment a]
fl ->
          -- If the field only has one line and no comments, then it can be
          -- rendered all on one line.
          Int -> [Comment a] -> Block
forall a. Int -> [Comment a] -> Block
comments Int
i (Name [Comment a] -> [Comment a]
forall a. Name a -> a
Name.annotation Name [Comment a]
n)
            Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> ( Line -> Block
Block.fromLine
                   (Line -> Block) -> (Line -> Line) -> Line -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Line Line Chunk Chunk -> (Chunk -> Chunk) -> Line -> Line
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter Line Line Chunk Chunk
Lens' Line Chunk
Line.chunkLens (Chunk -> Chunk -> Chunk
forall a. Monoid a => a -> a -> a
mappend (Chunk -> Chunk -> Chunk) -> Chunk -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Name [Comment a] -> Chunk
forall a. Name a -> Chunk
name Name [Comment a]
n Chunk -> Chunk -> Chunk
forall a. Semigroup a => a -> a -> a
<> Chunk
Chunk.colon)
                   (Line -> Block) -> Line -> Block
forall a b. (a -> b) -> a -> b
$ Int -> FieldLine [Comment a] -> Line
forall a. Int -> FieldLine a -> Line
fieldLine Int
i FieldLine [Comment a]
fl
               )
    [FieldLine [Comment a]]
_ ->
      ASetter Block Block Bool Bool -> Bool -> Block -> Block
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Block Block Bool Bool
Lens' Block Bool
Block.lineAfterLens Bool
True (Block -> Block) -> Block -> Block
forall a b. (a -> b) -> a -> b
$
        Int -> [Comment a] -> Block
forall a. Int -> [Comment a] -> Block
comments Int
i (Name [Comment a] -> [Comment a]
forall a. Name a -> a
Name.annotation Name [Comment a]
n)
          Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Line -> Block
Block.fromLine
            Line.Line
              { indent :: Int
Line.indent = Int
i,
                chunk :: Chunk
Line.chunk = Name [Comment a] -> Chunk
forall a. Name a -> Chunk
name Name [Comment a]
n Chunk -> Chunk -> Chunk
forall a. Semigroup a => a -> a -> a
<> Chunk
Chunk.colon
              }
          Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Int -> [FieldLine [Comment a]] -> Block
forall a. Int -> [FieldLine [Comment a]] -> Block
fieldLines (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [FieldLine [Comment a]]
fls
  Fields.Section Name [Comment a]
n [SectionArg [Comment a]]
sas [Field [Comment a]]
fs ->
    ASetter Block Block Bool Bool -> Bool -> Block -> Block
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Block Block Bool Bool
Lens' Block Bool
Block.lineBeforeLens Bool
True
      (Block -> Block) -> (Block -> Block) -> Block -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Block Block Bool Bool -> Bool -> Block -> Block
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Block Block Bool Bool
Lens' Block Bool
Block.lineAfterLens Bool
True
      (Block -> Block) -> Block -> Block
forall a b. (a -> b) -> a -> b
$ Int -> [Comment a] -> Block
forall a. Int -> [Comment a] -> Block
comments Int
i (Name [Comment a] -> [Comment a]
forall a. Name a -> a
Name.annotation Name [Comment a]
n)
        -- Section arguments should never have comments in practice. This is
        -- here simply to ensure that they aren't lost.
        Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Int -> [Comment a] -> Block
forall a. Int -> [Comment a] -> Block
comments Int
i ((SectionArg [Comment a] -> [Comment a])
-> [SectionArg [Comment a]] -> [Comment a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SectionArg [Comment a] -> [Comment a]
forall a. SectionArg a -> a
SectionArg.annotation [SectionArg [Comment a]]
sas)
        Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Line -> Block
Block.fromLine
          Line.Line
            { indent :: Int
Line.indent = Int
i,
              chunk :: Chunk
Line.chunk = 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
Chunk.spaceAfterLens Bool
True (Name [Comment a] -> Chunk
forall a. Name a -> Chunk
name Name [Comment a]
n) Chunk -> Chunk -> Chunk
forall a. Semigroup a => a -> a -> a
<> [SectionArg [Comment a]] -> Chunk
forall a. [SectionArg a] -> Chunk
sectionArgs [SectionArg [Comment a]]
sas
            }
        Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> ASetter Block Block Bool Bool -> Bool -> Block -> Block
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter Block Block Bool Bool
Lens' Block Bool
Block.lineBeforeLens Bool
False (Int -> [Field [Comment a]] -> Block
forall a. Int -> [Field [Comment a]] -> Block
fields (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Field [Comment a]]
fs)

name :: Fields.Name a -> Chunk.Chunk
name :: forall a. Name a -> Chunk
name = ByteString -> Chunk
Chunk.fromByteString (ByteString -> Chunk) -> (Name a -> ByteString) -> Name a -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> ByteString
forall a. Name a -> ByteString
Name.value

fieldLines :: Int -> [Fields.FieldLine [Comment.Comment a]] -> Block.Block
fieldLines :: forall a. Int -> [FieldLine [Comment a]] -> Block
fieldLines = (FieldLine [Comment a] -> Block)
-> [FieldLine [Comment a]] -> Block
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((FieldLine [Comment a] -> Block)
 -> [FieldLine [Comment a]] -> Block)
-> (Int -> FieldLine [Comment a] -> Block)
-> Int
-> [FieldLine [Comment a]]
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FieldLine [Comment a] -> Block
forall a. Int -> FieldLine [Comment a] -> Block
fieldLineC

fieldLineC :: Int -> Fields.FieldLine [Comment.Comment a] -> Block.Block
fieldLineC :: forall a. Int -> FieldLine [Comment a] -> Block
fieldLineC Int
i FieldLine [Comment a]
fl =
  Int -> [Comment a] -> Block
forall a. Int -> [Comment a] -> Block
comments Int
i (FieldLine [Comment a] -> [Comment a]
forall a. FieldLine a -> a
FieldLine.annotation FieldLine [Comment a]
fl)
    Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Line -> Block
Block.fromLine (Int -> FieldLine [Comment a] -> Line
forall a. Int -> FieldLine a -> Line
fieldLine Int
i FieldLine [Comment a]
fl)

fieldLine :: Int -> Fields.FieldLine a -> Line.Line
fieldLine :: forall a. Int -> FieldLine a -> Line
fieldLine Int
i =
  Int -> Chunk -> Line
Line.Line Int
i
    (Chunk -> Line) -> (FieldLine a -> Chunk) -> FieldLine a -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Chunk.spaceBeforeLens Bool
True
    (Chunk -> Chunk) -> (FieldLine a -> Chunk) -> FieldLine a -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Chunk
Chunk.fromByteString
    (ByteString -> Chunk)
-> (FieldLine a -> ByteString) -> FieldLine a -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLine a -> ByteString
forall a. FieldLine a -> ByteString
FieldLine.value

sectionArgs :: [Fields.SectionArg a] -> Chunk.Chunk
sectionArgs :: forall a. [SectionArg a] -> Chunk
sectionArgs = 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
Chunk.spaceBeforeLens Bool
True (Chunk -> Chunk)
-> ([SectionArg a] -> Chunk) -> [SectionArg a] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SectionArg a -> Chunk) -> [SectionArg a] -> Chunk
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SectionArg a -> Chunk
forall a. SectionArg a -> Chunk
sectionArg

sectionArg :: Fields.SectionArg a -> Chunk.Chunk
sectionArg :: forall a. SectionArg a -> Chunk
sectionArg SectionArg a
sa = case SectionArg a
sa of
  Fields.SecArgName a
_ ByteString
bs ->
    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
Chunk.spaceBeforeLens Bool
True
      (Chunk -> Chunk) -> (Chunk -> Chunk) -> Chunk -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Chunk.spaceAfterLens Bool
True
      (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ ByteString -> Chunk
Chunk.fromByteString ByteString
bs
  Fields.SecArgStr a
_ ByteString
bs ->
    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
Chunk.spaceBeforeLens Bool
True
      (Chunk -> Chunk) -> (ByteString -> Chunk) -> ByteString -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Chunk.spaceAfterLens Bool
True
      (Chunk -> Chunk) -> (ByteString -> Chunk) -> ByteString -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Chunk
Chunk.fromByteString
      (ByteString -> Chunk)
-> (ByteString -> ByteString) -> ByteString -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Word8 -> ByteString)
-> Word8 -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Word8 -> ByteString
ByteString.snoc Word8
0x22
      (ByteString -> Chunk) -> ByteString -> Chunk
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
ByteString.cons Word8
0x22 ByteString
bs
  Fields.SecArgOther a
_ ByteString
bs ->
    let b :: Bool
b =
          ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> ByteString
ByteString.singleton Word8
0x21 -- !
            Bool -> Bool -> Bool
&& ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> ByteString
ByteString.singleton Word8
0x28 -- (
            Bool -> Bool -> Bool
&& ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> ByteString
ByteString.singleton Word8
0x29 -- )
     in 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
Chunk.spaceBeforeLens Bool
b
          (Chunk -> Chunk) -> (Chunk -> Chunk) -> Chunk -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Chunk.spaceAfterLens Bool
b
          (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ ByteString -> Chunk
Chunk.fromByteString ByteString
bs

comments :: Int -> [Comment.Comment a] -> Block.Block
comments :: forall a. Int -> [Comment a] -> Block
comments Int
i [Comment a]
cs = Block
forall a. Monoid a => a
mempty {Block.lines = fmap (comment i) cs}

comment :: Int -> Comment.Comment a -> Line.Line
comment :: forall a. Int -> Comment a -> Line
comment Int
i =
  Int -> Chunk -> Line
Line.Line Int
i
    (Chunk -> Line) -> (Comment a -> Chunk) -> Comment a -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Chunk
Chunk.fromByteString
    (ByteString -> Chunk)
-> (Comment a -> ByteString) -> Comment a -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
Comment.delimiter
    (ByteString -> ByteString)
-> (Comment a -> ByteString) -> Comment a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment a -> ByteString
forall a. Comment a -> ByteString
Comment.value