ssg/src/SSG/Djot/Inline.idr

module SSG.Djot.Inline

import SSG.Parser.Core
import SSG.Parser.Util

import SSG.Djot.Common

import Control.Eff
import Control.Monad.Eval
import Derive.Prelude
import Derive.Pretty

-- For iutils unit tests
import System

%language ElabReflection

--******************
--*   Data Types   *
--******************

public export
data Inline : Type where
  HardLineBreak : Inline
  SoftLineBreak : Inline
  NonBreakingSpace : Inline
  Text : (c : String) -> Inline

%runElab derive "Inline" [Show, Eq, Pretty]

--******************
--* PostProcessing *
--******************

-- Combine adjacent `Text`s in the parsed output
combineTexts : List1 Inline -> Eval (List1 Inline)
combineTexts (Text c ::: (Text d :: xs)) =
  combineTexts (Text (c ++ d) ::: xs)
combineTexts (x ::: tail) = do
  rest <- combineTexts' tail
  pure $ x ::: rest
  where
    combineTexts' : List Inline -> Eval (List Inline)
    combineTexts' [] = pure []
    combineTexts' (y :: []) = pure [y]
    combineTexts' (Text c :: (Text d :: xs)) =
      combineTexts' (Text (c ++ d) :: xs)
    combineTexts' (y :: ys) = do
      rest <- combineTexts' ys
      pure $ y :: rest

-- Combine adjacent soft line breaks into one
combineSoftBreaks : List1 Inline -> Eval (List1 Inline)
combineSoftBreaks (SoftLineBreak ::: (SoftLineBreak :: xs)) =
  combineSoftBreaks (SoftLineBreak ::: xs)
combineSoftBreaks (head ::: tail) = do
  tail <- combineSoftBreaks' tail
  pure $ head ::: tail
  where
    combineSoftBreaks' : List Inline -> Eval (List Inline)
    combineSoftBreaks' [] = pure []
    combineSoftBreaks' (x :: []) = pure [x]
    combineSoftBreaks' (SoftLineBreak :: (SoftLineBreak :: xs)) =
      combineSoftBreaks' (SoftLineBreak :: xs)
    combineSoftBreaks' (x :: xs) = do
      rest <- combineSoftBreaks' xs
      pure $ x :: rest

-- Remove a trailing soft line break from a list of inlines
removeTrailingSoftBreak : List1 Inline -> Eval (List1 Inline)
removeTrailingSoftBreak (head ::: tail) = do
  tail <- inner tail
  pure $ head ::: tail
  where
    inner : List Inline -> Eval (List Inline)
    inner [] = pure []
    inner (SoftLineBreak :: []) = pure []
    inner (x :: xs) = do
      xs <- inner xs
      pure $ x :: xs

-- Combine all post processing steps
postProcess : List1 Inline -> List1 Inline
postProcess xs = eval $ do
  xs <- combineTexts xs
  xs <- combineSoftBreaks xs
  xs <- removeTrailingSoftBreak xs
  pure xs

--******************
--*     Syntax     *
--******************

------------------------
-- Escaped Whitespace --
------------------------

hardLineBreak : PS Inline
hardLineBreak = do
  _ <- thisString "\\"
  _ <- spaces
  _ <- lineEnding
  pure $ HardLineBreak

nbsp : PS Inline
nbsp = do
  _ <- thisString "\\ "
  pure $ NonBreakingSpace

softLineBreak : PS Inline
softLineBreak = do
  -- Slurp up any horizontal whitespace before the line break
  _ <- spaces
  _ <- lineEnding
  -- Check to see if the next line is empty, if it is, we are at the end of the inline
  -- content, go ahead and bail
  state <- save
  Nothing <- tryMaybe blankLine
    | Just _ => throw "End of inline"
  load state
  -- Slurp up any horizontal whitespace after the line break
  _ <- spaces
  pure $ SoftLineBreak

escapedNewLine : PS Inline
escapedNewLine = do
  -- Slurp up any horizontal whitespace before the line break
  _ <- spaces
  _ <- thisString "\\n"
  -- Slurp up any horizontal whitespace after the line break
  _ <- spaces
  pure $ SoftLineBreak

---------------------
-- Emphasis/Strong --
---------------------

----------
-- Text --
----------

-- Process escape codes before processing as text
escapedText : PS Inline
escapedText = do
  c <- escapedChar
  pure $ Text (singleton c)

-- Any non-line-ending character can be part of regular text
text : PS Inline
text = do
  c <- nonTerminal
  pure $ Text (singleton c)

---------------------------
-- Overall Inline Parser --
---------------------------

inlineElement : PS Inline
inlineElement = oneOfE "" [
    hardLineBreak
  , softLineBreak
  , escapedNewLine
  , nbsp
  , escapedText
  -- Text is last so that anything can superseed it
  , text
  ]

export
inline : PS (List1 Inline)
inline = map postProcess $
  atLeastOne "Expected Inline Content" inlineElement

--******************
--*   Unit Tests   *
--******************

-------------------------------
-- Testing Utility Functions --
-------------------------------


export
inlineFromString' : String -> List1 (Inline)
inlineFromString' str = Text str ::: []

export
inlineFromString : String -> List (Inline)
inlineFromString = forget . inlineFromString'
-----------
-- Tests --
-----------

-- @@test Plain Text Hello World
inlineTextSmoke : IO Bool
inlineTextSmoke =
  let input = "Hello World!" in
  golden input (inlineFromString input) (map forget inline)

-- @@test Escaped Text
inlineEscapedSmoke : IO Bool
inlineEscapedSmoke =
  let input = "Hello\\n\\*World"
      ref = [Text "Hello", SoftLineBreak, Text "*World"]
  in golden input ref (map forget inline)

-- @@test Hard Line Break
inlineHardBreakSmoke : IO Bool
inlineHardBreakSmoke =
  let input = "Hello\\\nWorld"
      ref = inlineFromString "Hello" ++ [HardLineBreak] ++ inlineFromString "World"
  in golden input ref (map forget inline)

-- @@test Soft Line Break
inlineSoftBreakSmoke : IO Bool
inlineSoftBreakSmoke =
  let input = "Hello\nWorld"
      ref = inlineFromString "Hello" ++ [SoftLineBreak] ++ inlineFromString "World"
  in golden input ref (map forget inline)

-- @@test Nonbreaking Space
inlineNbspSmoke : IO Bool
inlineNbspSmoke =
  let input = "Hello\\ World"
      ref = inlineFromString "Hello" ++ [NonBreakingSpace] ++ inlineFromString "World"
  in golden input ref (map forget inline)