-- |
-- == Terms #terms#
--
-- * @format@ - specific encoding of some information. See 'Format'.
-- * @document@ - 'T.Text' in a specific format, e.g., @Haskell@ (@.hs@) file.
-- * @document block@ - consecutive lines of a document.
-- * 'Token' - a representation of a document block as a @Haskell@ type.
-- * 'Tokens' - a list of 'Token's.
-- * @parser@ - a function that reads a document line by line and converts it to 'Tokens'. Example: 'hsToTokens'.
-- * @printer@ - a function that converts 'Tokens' to a document. Example: 'hsFromTokens'.
-- * @tag@ - a marker that affects how 'Tokens' are parsed.
--
--     * Each parser recognizes tags of a specific form.
--     * Tags can be represented as a wrapper and a name.
--
--         E.g., in @'% LIMA_DISABLE some text'@, a @TeX@ tag, the wrapper is @'% '@ and the name is @'LIMA_DISABLE some text'@.
--
--     * Parsers recognize the tag names that /start with/ tag names specified in a 'Config'.
--
--         E.g., in the example above, a parser will recognize the [_disable](#v:_disable) tag and will become disabled.
--
--     * When a parser is disabled, it copies lines verbatim into a 'Disabled' 'Token' and doesn't recognize any tags until it finds an [_enable](#v:_enable) tag.
--
-- == Assumptions #assumptions#
--
-- The following assumptions must hold for outputs of parsers and inputs of printers:
--
--     - 'Tokens' are in the same order as the corresponding blocks of document.
--     - Lines inside 'Tokens' are reversed compared to the document. Example:
--
--         - @Literate Haskell@ document:
--
--             @
--             line 1
--             line 2
--
--             % line 3
--
--             % line 4
--             @
--
--         - Corresponding 'Tokens':
--
--             @
--             [
--               Text {manyLines = ["line2","line 1"]},
--               Comment {someLines = "line 4" :| ["", "line 3"]}
--             ]
--             @
--
--      - There are no leading or trailing empty lines inside of 'Tokens'.
-- 
-- There are several forms of @Haskell@ code blocks in @Literate Haskell@ recognized by @GHC@.
--
-- 1. Code between @'\\begin{code}'@ and @'\\end{code}'@ tags.
--
--     @
--     \begin{code}
--        a = 42
--     \end{code}
--     \begin{code}
--        b = a
--     \end{code}
--     @
-- 
--     - The line starting with @'\\begin{code}'@ cannot have other non-space characters after @'\\begin{code}'@.
--     - The indentation of all expressions in code blocks must be the same.
--
-- 1. Code lines starting with @'> '@.
--
--     @
--     \begin{mycode}
--
--     >    a = 42
--
--     \end{mycode}
--     \begin{mycode}
--
--     >    b = a
--
--     \end{mycode}
--     @
--     
--     - There must be at least a single empty line before and after each @Haskell@ code block.
--     - Any text may surround @Haskell@ code blocks.
--     - The indentation of all expressions in code blocks must be the same.
--
-- This library supports only the second form as this form is more versatile.
-- 
-- Moreover, this form does not require writing @Markdown@ tags like @\'```haskell\'@.
-- 
-- Such tags will automatically be printed when converting @Literate Haskell@ to @Markdown@.
module Converter (
  -- * Config
  Mode,
  User,
  Internal,
  Config (..),
  def,
  toConfigInternal,

  -- ** Lenses
  disable,
  enable,
  indent,
  dedent,
  mdHaskellCodeStart,
  mdHaskellCodeEnd,
  texHaskellCodeStart,
  texHaskellCodeEnd,
  texSingleLineCommentStart,
  lhsSingleLineCommentStart,

  -- * microlens
  (&),
  (?~),

  -- * Format
  Format (..),
  convertTo,
  showFormatExtension,
  showFormatName,

  -- * Tokens
  Token (..),
  Tokens,
  selectFromTokens,
  selectToTokens,
  mergeTokens,
  stripTokens,
  normalizeTokens,

  -- * Printers
  hsFromTokens,
  hsFromTokens',
  lhsFromTokens,
  lhsFromTokens',
  mdFromTokens,
  mdFromTokens',
  texFromTokens,
  texFromTokens',

  -- * Parsers
  hsToTokens,
  lhsToTokens,
  mdToTokens,
  texToTokens,

  -- * Helpers
  mkFromTokens,
  mkToTokens,
  parseLineToToken,
  errorExpectedToken,
  errorNotEnoughTokens,
  pp,

  -- * Examples
  exampleNonTexTokens',
  exampleNonTexTokens,
  exampleTexTokens,
) where

import Converter.Internal (Pretty (..), PrettyPrint (..), constructorName, countSpaces, dropEmpties, dropLen, dropLhsComment, dropTexComment, errorEmptyCommentAt, hsCommentClose, hsCommentCloseSpace, hsCommentOpen, hsCommentOpenSpace, indentN, isHsComment, isMdComment, lhsCommentSpace, lhsEscapeHash, lhsHsCodeSpace, lhsUnescapeHash, mdCommentClose, mdCommentCloseSpace, mdCommentOpenSpace, prependLhsComment, prependTexComment, startsWith, stripEmpties, stripHsComment, stripMdComment, stripSpaces, texCommentSpace)
import Data.Char (isAlpha)
import Data.Data (Data)
import Data.Default (Default (def))
import Data.List (intersperse)
import Data.List.NonEmpty as NonEmpty (NonEmpty ((:|)), fromList, init, last, toList, (<|))
import Data.Text qualified as T
import GHC.Generics (Generic)
import Lens.Micro (non, to, (&), (?~), (^.))
import Lens.Micro.TH (makeLenses)
import Text.Read (readMaybe)
import Text.Show qualified as T

-- | A kind of data markers.
data Mode'
  = Internal
  | User

-- | Marks data for internal usage.
type Internal = 'Internal

-- | Marks data supplied by a user.
type User = 'User

-- | Calculates the mode for data.
type family Mode a where
  Mode User = Maybe String
  Mode Internal = T.Text

-- | Configuration of tag names.
--
-- The default values of @Config User@ are all 'Nothing's.
--
-- Inside the library functions, @Config User@ is converted to @Config Internal@.
--
-- The below examples show the names from @Config Internal@.
--
-- >>> pp (def :: Config User)
-- Config {
--   _disable = "LIMA_DISABLE",
--   _enable = "LIMA_ENABLE",
--   _indent = "LIMA_INDENT",
--   _dedent = "LIMA_DEDENT",
--   _mdHaskellCodeStart = "```haskell",
--   _mdHaskellCodeEnd = "```",
--   _texHaskellCodeStart = "\\begin{mycode}",
--   _texHaskellCodeEnd = "\\end{mycode}",
--   _texSingleLineCommentStart = "SINGLE_LINE ",
--   _lhsSingleLineCommentStart = "SINGLE_LINE "
-- }
--
-- It's possible to override these names.
--
-- >>> pp ((def :: Config User) & disable ?~ "off" & enable ?~ "on" & indent ?~ "indent" & dedent ?~ "dedent")
-- Config {
--   _disable = "off",
--   _enable = "on",
--   _indent = "indent",
--   _dedent = "dedent",
--   _mdHaskellCodeStart = "```haskell",
--   _mdHaskellCodeEnd = "```",
--   _texHaskellCodeStart = "\\begin{mycode}",
--   _texHaskellCodeEnd = "\\end{mycode}",
--   _texSingleLineCommentStart = "SINGLE_LINE ",
--   _lhsSingleLineCommentStart = "SINGLE_LINE "
-- }
data Config (a :: Mode') = Config
  { forall (a :: Mode'). Config a -> Mode a
_disable :: Mode a
  -- ^
  -- Make parser ignore tags and just copy the following lines verbatim.
  --
  -- Set indentation to @0@.
  , forall (a :: Mode'). Config a -> Mode a
_enable :: Mode a
  -- ^ Stop parser from ignoring tags.
  , forall (a :: Mode'). Config a -> Mode a
_indent :: Mode a
  -- ^ Set code indentation to a given 'Int'.
  , forall (a :: Mode'). Config a -> Mode a
_dedent :: Mode a
  -- ^ Set code indentation to @0@.
  , forall (a :: Mode'). Config a -> Mode a
_mdHaskellCodeStart :: Mode a
  -- ^ Mark the start of a @Haskell@ code block in @Markdown@.
  , forall (a :: Mode'). Config a -> Mode a
_mdHaskellCodeEnd :: Mode a
  -- ^ Mark the end of a @Haskell@ code block in @Markdown@.
  , forall (a :: Mode'). Config a -> Mode a
_texHaskellCodeStart :: Mode a
  -- ^ Mark the start of a @Haskell@ code block in @TeX@.
  , forall (a :: Mode'). Config a -> Mode a
_texHaskellCodeEnd :: Mode a
  -- ^ Mark the end of a @Haskell@ code block in @TeX@.
  , forall (a :: Mode'). Config a -> Mode a
_texSingleLineCommentStart :: Mode a
  -- ^ Mark start of a comment that must be single-line in @TeX@.
  , forall (a :: Mode'). Config a -> Mode a
_lhsSingleLineCommentStart :: Mode a
  -- ^ Mark start of a comment that must be single-line in @Literate Haskell@.
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: Mode') x. Rep (Config a) x -> Config a
forall (a :: Mode') x. Config a -> Rep (Config a) x
$cto :: forall (a :: Mode') x. Rep (Config a) x -> Config a
$cfrom :: forall (a :: Mode') x. Config a -> Rep (Config a) x
Generic)

makeLenses ''Config

deriving instance Show (Config User)
deriving instance Eq (Config User)
deriving instance Show (Config Internal)

instance PrettyPrint (Config User) where
  pp :: Config User -> Pretty String
  pp :: Config User -> Pretty String
pp (Config User -> Config Internal
toConfigInternal -> Config Internal
config) =
    forall a. PrettyPrint a => a -> Pretty String
pp forall a b. (a -> b) -> a -> b
$
      ( forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \(Char
a, Char
b) ->
              if
                  | [Char
a, Char
b] forall a. Eq a => a -> a -> Bool
== String
" _" -> String
"\n  "
                  | [Char
a, Char
b] forall a. Eq a => a -> a -> Bool
== String
"{_" -> String
"{\n  "
                  | Bool
otherwise -> [Char
a]
          )
          forall a b. (a -> b) -> a -> b
$ (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Show a => a -> String
show Config Internal
config) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Config Internal
config))
      )
        forall a. Semigroup a => a -> a -> a
<> String
"\n}"

instance Default (Config Internal) where
  def :: Config Internal
  def :: Config Internal
def = Config{Text
_lhsSingleLineCommentStart :: Text
_texSingleLineCommentStart :: Text
_texHaskellCodeEnd :: Text
_texHaskellCodeStart :: Text
_mdHaskellCodeEnd :: Text
_mdHaskellCodeStart :: Text
_dedent :: Text
_indent :: Text
_enable :: Text
_disable :: Text
$sel:_lhsSingleLineCommentStart:Config :: Mode Internal
$sel:_texSingleLineCommentStart:Config :: Mode Internal
$sel:_texHaskellCodeEnd:Config :: Mode Internal
$sel:_texHaskellCodeStart:Config :: Mode Internal
$sel:_mdHaskellCodeEnd:Config :: Mode Internal
$sel:_mdHaskellCodeStart:Config :: Mode Internal
$sel:_dedent:Config :: Mode Internal
$sel:_indent:Config :: Mode Internal
$sel:_enable:Config :: Mode Internal
$sel:_disable:Config :: Mode Internal
..}
   where
    _disable :: Text
_disable = Text
"LIMA_DISABLE"
    _enable :: Text
_enable = Text
"LIMA_ENABLE"
    _indent :: Text
_indent = Text
"LIMA_INDENT"
    _dedent :: Text
_dedent = Text
"LIMA_DEDENT"
    _mdHaskellCodeStart :: Text
_mdHaskellCodeStart = Text
"```haskell"
    _mdHaskellCodeEnd :: Text
_mdHaskellCodeEnd = Text
"```"
    _texHaskellCodeStart :: Text
_texHaskellCodeStart = Text
"\\begin{mycode}"
    _texHaskellCodeEnd :: Text
_texHaskellCodeEnd = Text
"\\end{mycode}"
    _texSingleLineCommentStart :: Text
_texSingleLineCommentStart = Text
"SINGLE_LINE"
    _lhsSingleLineCommentStart :: Text
_lhsSingleLineCommentStart = Text
"SINGLE_LINE"

deriving instance Default (Config User)

-- | Convert a user 'Config' to an internal 'Config' with user-supplied values.
--
-- It's important to do this conversion at a single entrypoint.
--
-- Otherwise, repeated conversions will accumulate changes such as appended spaces.
toConfigInternal :: Config User -> Config Internal
toConfigInternal :: Config User -> Config Internal
toConfigInternal Config User
conf =
  Config
    { $sel:_disable:Config :: Mode Internal
_disable = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
disable Text
_disable
    , $sel:_enable:Config :: Mode Internal
_enable = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
enable Text
_enable
    , $sel:_indent:Config :: Mode Internal
_indent = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
indent Text
_indent
    , $sel:_dedent:Config :: Mode Internal
_dedent = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
dedent Text
_dedent
    , $sel:_mdHaskellCodeStart:Config :: Mode Internal
_mdHaskellCodeStart = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
mdHaskellCodeStart Text
_mdHaskellCodeStart
    , $sel:_mdHaskellCodeEnd:Config :: Mode Internal
_mdHaskellCodeEnd = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
mdHaskellCodeEnd Text
_mdHaskellCodeEnd
    , $sel:_texHaskellCodeStart:Config :: Mode Internal
_texHaskellCodeStart = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
texHaskellCodeStart Text
_texHaskellCodeStart
    , $sel:_texHaskellCodeEnd:Config :: Mode Internal
_texHaskellCodeEnd = ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
texHaskellCodeEnd Text
_texHaskellCodeEnd
    , $sel:_texSingleLineCommentStart:Config :: Mode Internal
_texSingleLineCommentStart = (((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
texSingleLineCommentStart Text
_texSingleLineCommentStart) forall a. Semigroup a => a -> a -> a
<> Text
" "
    , $sel:_lhsSingleLineCommentStart:Config :: Mode Internal
_lhsSingleLineCommentStart = (((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l forall (a :: Mode'). Lens' (Config a) (Mode a)
lhsSingleLineCommentStart Text
_lhsSingleLineCommentStart) forall a. Semigroup a => a -> a -> a
<> Text
" "
    }
 where
  l :: ((Maybe String -> Const Text (Maybe String))
 -> Config User -> Const Text (Config User))
-> Text -> Text
l (Maybe String -> Const Text (Maybe String))
-> Config User -> Const Text (Config User)
a Text
b = Config User
conf forall s a. s -> Getting a s a -> a
^. (Maybe String -> Const Text (Maybe String))
-> Config User -> Const Text (Config User)
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
b
  Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..} = forall a. Default a => a
def @(Config Internal)

-- | A format of a document.
data Format
  = -- | @Haskell@
    Hs
  | -- | @Literate Haskell@
    Lhs
  | -- | @Markdown@
    Md
  | -- | @TeX@
    TeX
  deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq)

-- | Show a 'Format' as a file extension.
--
-- >>>showFormatExtension Lhs
-- "lhs"
showFormatExtension :: Format -> String
showFormatExtension :: Format -> String
showFormatExtension = \case
  Format
Hs -> String
"hs"
  Format
Md -> String
"md"
  Format
Lhs -> String
"lhs"
  Format
TeX -> String
"tex"

-- | Show a 'Format' as a full name.
--
-- >>>showFormatName Lhs
-- "Literate Haskell"
showFormatName :: Format -> String
showFormatName :: Format -> String
showFormatName = \case
  Format
Hs -> String
"Haskell"
  Format
Md -> String
"Markdown"
  Format
Lhs -> String
"Literate Haskell"
  Format
TeX -> String
"TeX"

-- | Internal representation of a document.
--
-- A printer processes 'Tokens' one by one.
--
-- A 'Token' can have:
--
-- - Action - how this 'Token' affects the subsequent 'Tokens'.
-- - Target - a type of 'Tokens' that are affected by this 'Token'.
-- - Range - the nearest 'Token' until which this 'Token' affects the subsequent 'Tokens'.
data Token
  = -- |
    -- - Action: set indentation to @n@.
    --
    -- - Target: 'HaskellCode'.
    --
    -- - Range: 'Indent', 'Dedent', or 'Disabled'.
    Indent {Token -> Int
n :: Int}
  | -- |
    -- - Action: set indentation to @0@.
    --
    -- - Target: 'HaskellCode'.
    --
    -- - Range: 'Indent', 'Dedent', or 'Disabled'.
    Dedent
  | -- | A block that should be invisible when rendered outside of @.hs@.
    --
    -- - Action: set indentation to @0@.
    --
    -- - Target: 'HaskellCode'.
    --
    -- - Range: 'Indent', 'Dedent', or 'Disabled'.
    Disabled {Token -> [Text]
manyLines :: [T.Text]}
  | -- | Lines copied verbatim while a parser was in a @Haskell@ code block.
    HaskellCode {manyLines :: [T.Text]}
  | -- | Lines copied verbatim while a parser was in a text block.
    Text {Token -> NonEmpty Text
someLines :: NonEmpty T.Text}
  | -- | Lines copied verbatim while a parser was in a comment block.
    Comment {someLines :: NonEmpty T.Text}
  | -- | A line of a comment that must be kept on a single-line.
    --
    -- E.g., {- FOURMOLU_DISABLE -} from a @.hs@.
    CommentSingleLine {Token -> Text
someLine :: T.Text}
  deriving (Int -> Token -> ShowS
Tokens -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: Tokens -> ShowS
$cshowList :: Tokens -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Typeable Token
Token -> DataType
Token -> Constr
(forall b. Data b => b -> b) -> Token -> Token
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Token -> u
forall u. (forall d. Data d => d -> u) -> Token -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Token -> m Token
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Token)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Token -> m Token
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Token -> m Token
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Token -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Token -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Token -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Token -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
gmapT :: (forall b. Data b => b -> b) -> Token -> Token
$cgmapT :: (forall b. Data b => b -> b) -> Token -> Token
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Token)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Token)
dataTypeOf :: Token -> DataType
$cdataTypeOf :: Token -> DataType
toConstr :: Token -> Constr
$ctoConstr :: Token -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
Data, Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq)

-- | A list of 'Token's.
type Tokens = [Token]

instance PrettyPrint (Tokens) where
  pp :: Tokens -> Pretty String
  pp :: Tokens -> Pretty String
pp Tokens
ts =
    forall a. String -> Pretty a
Pretty forall a b. (a -> b) -> a -> b
$
      ( forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \(Char
a, Char
b) ->
              if
                  | Char
a forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
b -> String
",\n  "
                  | Char
a forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
b -> String
"[\n  "
                  | Bool
otherwise -> [Char
a]
          )
          forall a b. (a -> b) -> a -> b
$ (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Show a => a -> String
show Tokens
ts) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Tokens
ts))
      )
        forall a. Semigroup a => a -> a -> a
<> String
"\n]"

-- | Select a printer function based on a given format.
selectFromTokens :: Config User -> Format -> Tokens -> T.Text
selectFromTokens :: Config User -> Format -> Tokens -> Text
selectFromTokens Config User
config Format
format =
  ( case Format
format of
      Format
Hs -> Config User -> Tokens -> Text
hsFromTokens
      Format
Lhs -> Config User -> Tokens -> Text
lhsFromTokens
      Format
Md -> Config User -> Tokens -> Text
mdFromTokens
      Format
TeX -> Config User -> Tokens -> Text
texFromTokens
  )
    Config User
config

-- | Select a parser function based on a given format.
selectToTokens :: Config User -> Format -> T.Text -> Tokens
selectToTokens :: Config User -> Format -> Text -> Tokens
selectToTokens Config User
config Format
format =
  ( case Format
format of
      Format
Hs -> Config User -> Text -> Tokens
hsToTokens
      Format
Lhs -> Config User -> Text -> Tokens
lhsToTokens
      Format
Md -> Config User -> Text -> Tokens
mdToTokens
      Format
TeX -> Config User -> Text -> Tokens
texToTokens
  )
    Config User
config

-- | Example non-@TeX@ 'Tokens'. See 'exampleTexTokens'.
--
-- When printed to a @TeX@ document, these 'Tokens' can't be correctly parsed.
-- This is because they don't have necessary tags surrounding @Haskell@ code blocks.
--
-- >>> pp $ exampleNonTexTokens'
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["   b = a 4","   a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "Hello from comments," :| []},
--   Comment {someLines = "world!" :| []},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "Hello from text," :| []},
--   Text {someLines = "world!" :| []}
-- ]
exampleNonTexTokens' :: Tokens
exampleNonTexTokens' :: Tokens
exampleNonTexTokens' =
  [ Int -> Token
Indent Int
3
  , Disabled{$sel:manyLines:Indent :: [Text]
manyLines = [Text
"-- What's the answer?"]}
  , Int -> Token
Indent Int
1
  , Int -> Token
Indent Int
2
  , NonEmpty Text -> Token
Text (Text
"- Intermediate results" forall a. a -> [a] -> NonEmpty a
:| [])
  , [Text] -> Token
HaskellCode [Text
"   b = a 4", Text
"   a = const 3"]
  , Token
Dedent
  , [Text] -> Token
HaskellCode [Text
"answer = b * 14"]
  , NonEmpty Text -> Token
Comment (Text
"Hello from comments," forall a. a -> [a] -> NonEmpty a
:| [])
  , NonEmpty Text -> Token
Comment (Text
"world!" forall a. a -> [a] -> NonEmpty a
:| [])
  , Text -> Token
CommentSingleLine (Text
"Comment on a single line.")
  , NonEmpty Text -> Token
Text (Text
"Hello from text," forall a. a -> [a] -> NonEmpty a
:| [])
  , NonEmpty Text -> Token
Text (Text
"world!" forall a. a -> [a] -> NonEmpty a
:| [])
  ]

-- | Merge specific consecutive 'Tokens'.
--
-- >>> pp exampleNonTexTokens'
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["   b = a 4","   a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "Hello from comments," :| []},
--   Comment {someLines = "world!" :| []},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "Hello from text," :| []},
--   Text {someLines = "world!" :| []}
-- ]
--
-- >>> pp $ mergeTokens exampleNonTexTokens'
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["   b = a 4","   a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "world!" :| ["","Hello from comments,"]},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "world!" :| ["","Hello from text,"]}
-- ]
mergeTokens :: Tokens -> Tokens
mergeTokens :: Tokens -> Tokens
mergeTokens (t1 :: Token
t1@Text{} : t2 :: Token
t2@Text{} : Tokens
ts) = Tokens -> Tokens
mergeTokens forall a b. (a -> b) -> a -> b
$ Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Token -> NonEmpty Text
someLines Token
t2 forall a. Semigroup a => a -> a -> a
<> (Text
T.empty forall a. a -> NonEmpty a -> NonEmpty a
<| Token -> NonEmpty Text
someLines Token
t1)} forall a. a -> [a] -> [a]
: Tokens
ts
mergeTokens (Comment{$sel:someLines:Indent :: Token -> NonEmpty Text
someLines = NonEmpty Text
ls1} : Comment{$sel:someLines:Indent :: Token -> NonEmpty Text
someLines = NonEmpty Text
ls2} : Tokens
ts) =
  Tokens -> Tokens
mergeTokens forall a b. (a -> b) -> a -> b
$ Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = NonEmpty Text
ls2 forall a. Semigroup a => a -> a -> a
<> (Text
T.empty forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
ls1)} forall a. a -> [a] -> [a]
: Tokens
ts
mergeTokens (Token
t : Tokens
ts) = Token
t forall a. a -> [a] -> [a]
: Tokens -> Tokens
mergeTokens Tokens
ts
mergeTokens Tokens
ts = Tokens
ts

-- | Strip empty lines and leading spaces in 'Tokens'.
--
-- - Remove empty lines in 'Tokens'.
-- - Shift lines in 'HaskellCode' to the left by the minimal number of leading spaces in nonempty lines.
--
-- >>> pp exampleNonTexTokens'
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["   b = a 4","   a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "Hello from comments," :| []},
--   Comment {someLines = "world!" :| []},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "Hello from text," :| []},
--   Text {someLines = "world!" :| []}
-- ]
--
-- >>> pp $ stripTokens exampleNonTexTokens'
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["b = a 4","a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "Hello from comments," :| []},
--   Comment {someLines = "world!" :| []},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "Hello from text," :| []},
--   Text {someLines = "world!" :| []}
-- ]
stripTokens :: Tokens -> Tokens
stripTokens :: Tokens -> Tokens
stripTokens Tokens
xs =
  ( \case
      Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> Disabled{$sel:manyLines:Indent :: [Text]
manyLines = [Text] -> [Text]
stripEmpties [Text]
manyLines}
      HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} ->
        let ls :: [Text]
ls = [Text] -> [Text]
stripEmpties [Text]
manyLines
         in HaskellCode{$sel:manyLines:Indent :: [Text]
manyLines = Int -> Text -> Text
T.drop (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Text -> Int
countSpaces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
ls)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ls}
      Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = forall a. [a] -> NonEmpty a
fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
stripEmpties (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines)}
      Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = forall a. [a] -> NonEmpty a
fromList forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
stripEmpties (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines)}
      Token
x -> Token
x
  )
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens
xs

-- | 'mergeTokens' and 'stripTokens'.
--
-- >>>pp $ normalizeTokens exampleNonTexTokens
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["b = a 4","a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "world!" :| ["","Hello from comments,"]},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "world!" :| ["","Hello from text,"]}
-- ]
normalizeTokens :: Tokens -> Tokens
normalizeTokens :: Tokens -> Tokens
normalizeTokens Tokens
tokens = Tokens -> Tokens
stripTokens forall a b. (a -> b) -> a -> b
$ Tokens -> Tokens
mergeTokens forall a b. (a -> b) -> a -> b
$ Tokens
tokens

-- | Normalized 'exampleNonTexTokens''.
--
-- >>>pp $ exampleNonTexTokens
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "- Intermediate results" :| []},
--   HaskellCode {manyLines = ["b = a 4","a = const 3"]},
--   Dedent,
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Comment {someLines = "world!" :| ["","Hello from comments,"]},
--   CommentSingleLine {someLine = "Comment on a single line."},
--   Text {someLines = "world!" :| ["","Hello from text,"]}
-- ]
exampleNonTexTokens :: Tokens
exampleNonTexTokens :: Tokens
exampleNonTexTokens = Tokens -> Tokens
normalizeTokens Tokens
exampleNonTexTokens'

-- | same as 'exampleNonTexTokens', but with @TeX@-specific tags that make @Haskell@ code blocks correctly parsable.
--
-- >>> pp $ exampleTexTokens
-- [
--   Indent {n = 3},
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 0},
--   Text {someLines = "\\begin{mycode}" :| ["","Intermediate results"]},
--   HaskellCode {manyLines = ["b = a 4","a = const 3"]},
--   Text {someLines = "\\end{mycode}" :| []},
--   Dedent,
--   Text {someLines = "\\begin{mycode}" :| []},
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Text {someLines = "\\end{mycode}" :| []},
--   Comment {someLines = "world!" :| ["","Hello from comments,"]},
--   CommentSingleLine {someLine = "Comment on a single line."}
-- ]

exampleTexTokens :: Tokens
exampleTexTokens :: Tokens
exampleTexTokens =
  Tokens -> Tokens
normalizeTokens forall a b. (a -> b) -> a -> b
$
    [ Int -> Token
Indent Int
3
    , Disabled{$sel:manyLines:Indent :: [Text]
manyLines = [Text
"-- What's the answer?"]}
    , Int -> Token
Indent Int
1
    , Int -> Token
Indent Int
0
    , Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"Intermediate results" forall a. a -> [a] -> NonEmpty a
:| []}
    , Token
codeStart
    , [Text] -> Token
HaskellCode [Text
"   b = a 4", Text
"   a = const 3"]
    , Token
codeEnd
    , Token
Dedent
    , Token
codeStart
    , [Text] -> Token
HaskellCode [Text
"answer = b * 14"]
    , Token
codeEnd
    , NonEmpty Text -> Token
Comment (Text
"Hello from comments," forall a. a -> [a] -> NonEmpty a
:| [])
    , NonEmpty Text -> Token
Comment (Text
"world!" forall a. a -> [a] -> NonEmpty a
:| [])
    , Text -> Token
CommentSingleLine (Text
"Comment on a single line.")
    ]
  where 
    codeStart :: Token
codeStart = Text{$sel:someLines:Indent :: NonEmpty Text
someLines = forall a. Default a => a
def @(Config Internal) forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a)
texHaskellCodeStart forall a. a -> [a] -> NonEmpty a
:| []}
    codeEnd :: Token
codeEnd = Text{$sel:someLines:Indent :: NonEmpty Text
someLines = forall a. Default a => a
def @(Config Internal) forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a)
texHaskellCodeEnd forall a. a -> [a] -> NonEmpty a
:| []}

-- | Compose a function that converts a document in one 'Format' to a document in another 'Format'.
convertTo :: Format -> Format -> Config User -> T.Text -> T.Text
convertTo :: Format -> Format -> Config User -> Text -> Text
convertTo Format
a Format
b Config User
config Text
src = Config User -> Format -> Tokens -> Text
selectFromTokens Config User
config Format
b forall a b. (a -> b) -> a -> b
$ Config User -> Format -> Text -> Tokens
selectToTokens Config User
config Format
a Text
src

-- | State of a parser.
--
-- Only one flag can be enabled when processing a line.
--
-- Flags signify in what document block a converter is at the moment.
data State = State
  { State -> Bool
inText :: Bool
  , State -> Bool
inHaskellCode :: Bool
  , State -> Bool
inDisabled :: Bool
  , State -> Bool
inComment :: Bool
  }
  deriving (forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic)

instance Default State where
  def :: State
  def :: State
def =
    State
      { $sel:inText:State :: Bool
inText = Bool
False
      , $sel:inHaskellCode:State :: Bool
inHaskellCode = Bool
False
      , $sel:inDisabled:State :: Bool
inDisabled = Bool
False
      , $sel:inComment:State :: Bool
inComment = Bool
False
      }

-- | Compose a function from 'Tokens' to a 'T.Text'.
mkFromTokens :: (Config User -> Tokens -> [T.Text]) -> Config User -> Tokens -> T.Text
mkFromTokens :: (Config User -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
f' Config User
config = (forall a. Semigroup a => a -> a -> a
<> Text
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config User -> Tokens -> [Text]
f' Config User
config

-- | Compose a function from a 'T.Text' to 'Tokens'.
mkToTokens :: (State -> [(Int, T.Text)] -> [Token] -> [Token]) -> T.Text -> Tokens
mkToTokens :: (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkToTokens State -> [(Int, Text)] -> Tokens -> Tokens
toTokens Text
xs = Tokens -> Tokens
normalizeTokens (forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (Text -> [Text]
T.lines Text
xs)) [Token
Dedent])

-- | Parse a single line to a token.
--
-- - Merge comments
parseLineToToken :: Config Internal -> Format -> Token -> T.Text -> Int -> Tokens
parseLineToToken :: Config Internal -> Format -> Token -> Text -> Int -> Tokens
parseLineToToken Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..} Format
format Token
prev Text
l Int
lineNumber
  | Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_indent =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Expected a number after " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Mode Internal
_indent forall a. Semigroup a => a -> a -> a
<> String
" at line: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
lineNumber)
        (\Int
x -> [Int -> Token
Indent (forall a. Ord a => a -> a -> a
max Int
0 Int
x), Token
prev])
        (forall a. Read a => String -> Maybe a
readMaybe @Int (Text -> String
T.unpack (Text -> Text -> Text
dropLen Mode Internal
_indent Text
l)))
  | Text
l forall a. Eq a => a -> a -> Bool
== Mode Internal
_dedent = [Token
Dedent, Token
prev]
  | Format
format forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Format
Md, Format
Hs] = [CommentSingleLine{$sel:someLine:Indent :: Text
someLine = Text
l}, Token
prev]
  | Format
format forall a. Eq a => a -> a -> Bool
== Format
TeX Bool -> Bool -> Bool
&& Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_texSingleLineCommentStart =
      [CommentSingleLine{$sel:someLine:Indent :: Text
someLine = Text -> Text -> Text
dropLen Mode Internal
_texSingleLineCommentStart Text
l}, Token
prev]
  | Format
format forall a. Eq a => a -> a -> Bool
== Format
Lhs Bool -> Bool -> Bool
&& Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_lhsSingleLineCommentStart =
      [CommentSingleLine{$sel:someLine:Indent :: Text
someLine = Text -> Text -> Text
dropLen Mode Internal
_lhsSingleLineCommentStart Text
l}, Token
prev]
  | Bool
otherwise =
      case Token
prev of
        Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> [Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines}]
        Token
_ -> [NonEmpty Text -> Token
Comment (Text
l forall a. a -> [a] -> NonEmpty a
:| []), Token
prev]

-- | Show error with line number for a token.
errorExpectedToken :: (Data a1, Show a2, Show a3) => a2 -> a3 -> a1 -> a4
errorExpectedToken :: forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken a2
lineNumber a3
lastToken a1
expectedToken =
  forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
    (String
"Wrong state at line: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a2
lineNumber forall a. Semigroup a => a -> a -> a
<> String
".\n\n")
      forall a. Semigroup a => a -> a -> a
<> (String
"Please, create an issue in the package repository.\n\n")
      forall a. Semigroup a => a -> a -> a
<> (String
"Expected last token: " forall a. Semigroup a => a -> a -> a
<> forall a. Data a => a -> String
constructorName a1
expectedToken forall a. Semigroup a => a -> a -> a
<> String
"\n\n")
      forall a. Semigroup a => a -> a -> a
<> (String
"Got last token: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a3
lastToken forall a. Semigroup a => a -> a -> a
<> String
"\n\n")

errorNotEnoughTokens :: Format -> a
errorNotEnoughTokens :: forall a. Format -> a
errorNotEnoughTokens Format
format = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Got not enough tokens when converting 'Tokens' to " forall a. Semigroup a => a -> a -> a
<> Format -> String
showFormatName Format
format

-- | Convert 'Tokens' to @TeX@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
-- - These are the relations between tokens and document blocks when the default 'Config' values are used.
--
--     - 'Indent' ~ @'% LIMA_INDENT N'@ (@N@ is an 'Int').
--     - 'Dedent' ~ @'% LIMA_DEDENT'@.
--     - 'Disabled' ~ @'% LIMA_DISABLE'@ and @'% LIMA_ENABLE'@ and lines between them.
--     - 'CommentSingleLine' ~ a line starting with @'% SINGLE_LINE '@.
--
--         @
--         % SINGLE_LINE line
--         @
--
--     - 'Comment' ~ consecutive lines, either empty or starting with @'% '@.
--
--         @
--         % Hello,
--         % world!
--
--         % Hello,
--         % user!
--         @
--
--         - At least one line must have nonempty text after @'% '@.
--
--     - 'HaskellCode' ~ lines between possibly indented tags @'\\begin{code}'@ and @'\\end{code}'@.
--
--         - Inside a 'Token', code will be shifted to the left. See 'normalizeTokens'.
--         - When printing the 'Tokens', code will be indented according to previous 'Tokens'.
--
--     - 'Text' ~ other lines.
--
-- === __Example__
--
-- >>> pp $ texFromTokens def exampleTexTokens
-- % LIMA_INDENT 3
-- <BLANKLINE>
-- % LIMA_DISABLE
-- <BLANKLINE>
-- % -- What's the answer?
-- <BLANKLINE>
-- % LIMA_ENABLE
-- <BLANKLINE>
-- % LIMA_INDENT 1
-- <BLANKLINE>
-- % LIMA_INDENT 0
-- <BLANKLINE>
-- Intermediate results
-- <BLANKLINE>
-- \begin{mycode}
-- a = const 3
-- b = a 4
-- \end{mycode}
-- <BLANKLINE>
-- % LIMA_DEDENT
-- <BLANKLINE>
-- \begin{mycode}
-- answer = b * 14
-- \end{mycode}
-- <BLANKLINE>
-- % Hello from comments,
-- <BLANKLINE>
-- % world!
-- <BLANKLINE>
-- % SINGLE_LINE Comment on a single line.
texFromTokens :: Config User -> Tokens -> T.Text
texFromTokens :: Config User -> Tokens -> Text
texFromTokens = (Config User -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
texFromTokens'

-- | Convert 'Tokens' to @TeX@ code.
--
-- Each 'Token' becomes a 'T.Text' in a list.
--
-- These 'T.Text's are concatenated in 'texFromTokens'.
texFromTokens' :: Config User -> Tokens -> [T.Text]
texFromTokens' :: Config User -> Tokens -> [Text]
texFromTokens' (Config User -> Config Internal
toConfigInternal -> Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Tokens
tokens =
  [Text] -> [Text]
dropEmpties forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ (Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens (Token
Dedent forall a. a -> [a] -> [a]
: Tokens
tokens) (Int
0, [])))
 where
  fromTokens :: Tokens -> (Int, [[T.Text]]) -> [[T.Text]]
  fromTokens :: Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens bs' :: Tokens
bs'@(Token
_ : Token
cur : Tokens
bs) (Int
curIndent, [[Text]]
rs) =
    Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens (Token
cur forall a. a -> [a] -> [a]
: Tokens
bs) (Int -> Tokens -> [[Text]] -> (Int, [[Text]])
translate Int
curIndent Tokens
bs' [[Text]]
rs)
  fromTokens [Token
_] (Int
_, [[Text]]
rs) = [[Text]]
rs
  fromTokens Tokens
_ (Int, [[Text]])
_ = forall a. Format -> a
errorNotEnoughTokens Format
TeX
  translate :: Int -> Tokens -> [[Text]] -> (Int, [[Text]])
translate Int
curIndent (Token
prev : Token
cur : Tokens
_) [[Text]]
rs =
    case Token
cur of
      Indent{Int
n :: Int
$sel:n:Indent :: Token -> Int
..} -> (Int
n,) forall a b. (a -> b) -> a -> b
$ [Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
n)] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs
      Token
Dedent -> (Int
0,) forall a b. (a -> b) -> a -> b
$ [Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_dedent] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs
      Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Int
0,) forall a b. (a -> b) -> a -> b
$ [[Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_enable], [], (Text -> Text
prependTexComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
manyLines), [], [Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_disable], []] forall a. Semigroup a => a -> a -> a
<> [[Text]]
rs
      HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} ->
        (Int
curIndent,) forall a b. (a -> b) -> a -> b
$
          (Int -> Text -> Text
indentN Int
curIndent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
manyLines)
            forall a. a -> [a] -> [a]
: ( case Token
prev of
                  Text{} -> [[Text]]
rs
                  Token
_ -> [] forall a. a -> [a] -> [a]
: [[Text]]
rs
              )
      Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} ->
        (Int
curIndent,) forall a b. (a -> b) -> a -> b
$
          forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines
            forall a. a -> [a] -> [a]
: ( case Token
prev of
                  HaskellCode{} -> [[Text]]
rs
                  Token
_ -> [] forall a. a -> [a] -> [a]
: [[Text]]
rs
              )
      Comment{$sel:someLines:Indent :: Token -> NonEmpty Text
someLines = Text
t :| [Text]
ts} -> (Int
curIndent, (Text -> Text
prependTexComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
t forall a. a -> [a] -> [a]
: [Text]
ts)) forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      CommentSingleLine{Text
someLine :: Text
$sel:someLine:Indent :: Token -> Text
someLine} -> (Int
curIndent, [Text -> Text
prependTexComment forall a b. (a -> b) -> a -> b
$ Mode Internal
_texSingleLineCommentStart forall a. Semigroup a => a -> a -> a
<> Text
someLine] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
  translate Int
_ Tokens
_ [[Text]]
_ = forall a. Format -> a
errorNotEnoughTokens Format
TeX

-- | Convert 'Tokens' to @TeX@ code.
--
-- Inverse of 'texFromTokens'.
--
-- >>> (texToTokens def $ texFromTokens def exampleTexTokens) == exampleTexTokens
-- True
texToTokens :: Config User -> T.Text -> Tokens
texToTokens :: Config User -> Text -> Tokens
texToTokens (Config User -> Config Internal
toConfigInternal -> conf :: Config Internal
conf@Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkToTokens State -> [(Int, Text)] -> Tokens -> Tokens
toTokens Text
xs
  toTokens :: State -> [(Int, T.Text)] -> Tokens -> Tokens
  toTokens :: State -> [(Int, Text)] -> Tokens -> Tokens
toTokens State{Bool
inComment :: Bool
inDisabled :: Bool
inHaskellCode :: Bool
inText :: Bool
$sel:inComment:State :: State -> Bool
$sel:inDisabled:State :: State -> Bool
$sel:inHaskellCode:State :: State -> Bool
$sel:inText:State :: State -> Bool
..} ((Int
lineNumber, Text
l) : [(Int, Text)]
ls) result :: Tokens
result@(Token
r : Tokens
rs)
    | Bool
inDisabled =
        if
            | -- enable
              Text
l Text -> Text -> Bool
`startsWith` (Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_enable) ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
            | -- copy lines
              Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inDisabled :: Bool
$sel:inDisabled:State :: Bool
inDisabled} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = forall a. Show a => Text -> a -> Text
dropTexComment Text
l Int
lineNumber forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Disabled{}
    | Bool
inHaskellCode =
        if
            | -- end of a snippet
              Text -> Text
stripSpaces Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_texHaskellCodeEnd ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls (Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
result)
            | Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inHaskellCode :: Bool
$sel:inHaskellCode:State :: Bool
inHaskellCode} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = Text
l forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected HaskellCode{}
    | Text -> Text
stripSpaces Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_texHaskellCodeStart =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inHaskellCode:State :: Bool
inHaskellCode = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          HaskellCode{$sel:manyLines:Indent :: [Text]
manyLines = []}
            forall a. a -> [a] -> [a]
: case Token
r of
              Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs
              Token
_ -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
result
    | -- Comment on a single line.
      Text
l Text -> Text -> Bool
`startsWith` Text
texCommentSpace =
        let l' :: Text
l' = Text -> Text -> Text
dropLen Text
texCommentSpace Text
l
         in if
                | -- disable
                  Text
l' Text -> Text -> Bool
`startsWith` Mode Internal
_disable ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inDisabled:State :: Bool
inDisabled = Bool
True} [(Int, Text)]
ls ([Text] -> Token
Disabled [] forall a. a -> [a] -> [a]
: Tokens
result)
                | Bool
otherwise ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                      Config Internal -> Format -> Token -> Text -> Int -> Tokens
parseLineToToken Config Internal
conf Format
TeX Token
r Text
l' Int
lineNumber forall a. Semigroup a => a -> a -> a
<> Tokens
rs
    | Bool
inText =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inText :: Bool
$sel:inText:State :: Bool
inText} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          case Token
r of
            Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs
            Token
_ -> Token -> Tokens
errorExpected Text{}
    | -- a blank line
      Text -> Bool
T.null Text
l =
        case Token
r of
          Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines} -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inComment :: Bool
$sel:inComment:State :: Bool
inComment} [(Int, Text)]
ls (Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs)
          Token
_ -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
    | -- start of a text
      Bool
otherwise =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
result
   where
    errorExpected :: Token -> Tokens
errorExpected = forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res

-- | Convert 'Tokens' to @Literate Haskell@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
--
-- - These are the relations between document blocks and tokens when the default 'Config' values are used.
--
--     - 'Indent' ~ @'% LIMA_INDENT N'@ (@N@ is an 'Int').
--     - 'Dedent' ~ @'% LIMA_DEDENT'@.
--     - 'Disabled' ~ Lines between and including @'% LIMA_DISABLE'@ and @'% LIMA_ENABLE'@.
--
--         - There must be at least one nonempty line between these tags.
--
--     - 'CommentSingleLine' ~ a line starting with @'% SINGLE_LINE '@.
--
--         @
--         % SINGLE_LINE line
--         @
--
--     - 'Comment' ~ consecutive lines, either empty or starting with @'% '@.
--
--         @
--         % Hello,
--         % world!
--
--         % Hello,
--         % user!
--         @
--
--         - At least one line must have nonempty text after @'% '@
--
--     - 'HaskellCode' ~ consecutive lines starting with @'> '@.
--
--         @
--         > a4 = 4
--         > a2 = 2
--         @
--
--         - Inside a 'Token', code is shifted to the left. See 'normalizeTokens'.
--         - During printing, code is indented according to previous 'Tokens'.
--
--     - 'Text' ~ other lines.
--
-- === __Example__
--
-- >>> pp $ lhsFromTokens def exampleNonTexTokens
-- % LIMA_INDENT 3
-- <BLANKLINE>
-- % LIMA_DISABLE
-- <BLANKLINE>
-- % -- What's the answer?
-- <BLANKLINE>
-- % LIMA_ENABLE
-- <BLANKLINE>
-- % LIMA_INDENT 1
-- <BLANKLINE>
-- % LIMA_INDENT 2
-- <BLANKLINE>
-- - Intermediate results
-- <BLANKLINE>
-- >   a = const 3
-- >   b = a 4
-- <BLANKLINE>
-- % LIMA_DEDENT
-- <BLANKLINE>
-- > answer = b * 14
-- <BLANKLINE>
-- % Hello from comments,
-- <BLANKLINE>
-- % world!
-- <BLANKLINE>
-- % SINGLE_LINE Comment on a single line.
-- <BLANKLINE>
-- Hello from text,
-- <BLANKLINE>
-- world!
lhsFromTokens :: Config User -> Tokens -> T.Text
lhsFromTokens :: Config User -> Tokens -> Text
lhsFromTokens Config User
config Tokens
tokens = (Config User -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
lhsFromTokens' Config User
config Tokens
tokens

-- | Convert 'Tokens' to @Literate Haskell@ code.
--
-- Each 'Token' becomes a 'T.Text' in a list.
--
-- These 'T.Text's are concatenated in 'lhsFromTokens'.
lhsFromTokens' :: Config User -> Tokens -> [T.Text]
lhsFromTokens' :: Config User -> Tokens -> [Text]
lhsFromTokens' (Config User -> Config Internal
toConfigInternal -> Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Tokens
blocks =
  [Text] -> [Text]
dropEmpties forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens (Tokens
blocks) (Int
0, [])))
 where
  fromTokens :: Tokens -> (Int, [[T.Text]]) -> [[T.Text]]
  fromTokens :: Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens (Token
cur : Tokens
bs) (Int
curIndent, [[Text]]
rs) =
    Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens Tokens
bs (Int -> Tokens -> [[Text]] -> (Int, [[Text]])
translate Int
curIndent (Token
cur forall a. a -> [a] -> [a]
: Tokens
bs) [[Text]]
rs)
  fromTokens [] (Int
_, [[Text]]
rs) = [[Text]]
rs
  translate :: Int -> Tokens -> [[Text]] -> (Int, [[Text]])
translate Int
curIndent (Token
cur : Tokens
_) [[Text]]
rs =
    case Token
cur of
      Indent{Int
n :: Int
$sel:n:Indent :: Token -> Int
..} -> (Int
n, [Text
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
n)] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      Token
Dedent -> (Int
0, [Text
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_dedent] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Int
0, [Text
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_enable] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: (Text -> Text
prependLhsComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
manyLines) forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [Text
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_disable] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Int
curIndent, ((Text
lhsHsCodeSpace forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
indentN Int
curIndent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
manyLines) forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> (Int
curIndent, forall a. NonEmpty a -> [a]
toList (Text -> Text
lhsEscapeHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
someLines) forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      Comment{$sel:someLines:Indent :: Token -> NonEmpty Text
someLines = Text
t :| [Text]
ts} -> (Int
curIndent, (Text -> Text
prependLhsComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
t forall a. a -> [a] -> [a]
: [Text]
ts) forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
      CommentSingleLine{Text
someLine :: Text
$sel:someLine:Indent :: Token -> Text
someLine} -> (Int
curIndent, [Text -> Text
prependLhsComment forall a b. (a -> b) -> a -> b
$ Mode Internal
_lhsSingleLineCommentStart forall a. Semigroup a => a -> a -> a
<> Text
someLine] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs)
  translate Int
_ Tokens
_ [[Text]]
_ = forall a. Format -> a
errorNotEnoughTokens Format
Lhs

-- | Convert 'Tokens' to @Markdown@ code.
--
-- Inverse of 'lhsFromTokens'.
--
-- >>> (lhsToTokens def $ lhsFromTokens def exampleNonTexTokens) == exampleNonTexTokens
-- True
lhsToTokens :: Config User -> T.Text -> Tokens
lhsToTokens :: Config User -> Text -> Tokens
lhsToTokens (Config User -> Config Internal
toConfigInternal -> conf :: Config Internal
conf@Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkToTokens State -> [(Int, Text)] -> Tokens -> Tokens
toTokens Text
xs
  toTokens :: State -> [(Int, T.Text)] -> Tokens -> Tokens
  toTokens :: State -> [(Int, Text)] -> Tokens -> Tokens
toTokens State{Bool
inComment :: Bool
inDisabled :: Bool
inHaskellCode :: Bool
inText :: Bool
$sel:inComment:State :: State -> Bool
$sel:inDisabled:State :: State -> Bool
$sel:inHaskellCode:State :: State -> Bool
$sel:inText:State :: State -> Bool
..} ((Int
lineNumber, Text -> Text
lhsUnescapeHash -> Text
l) : [(Int, Text)]
ls) result :: Tokens
result@(Token
r : Tokens
rs)
    | Bool
inDisabled =
        if
            | -- enable
              Text
l Text -> Text -> Bool
`startsWith` (Text
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_enable) ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
            | -- copy lines
              Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inDisabled :: Bool
$sel:inDisabled:State :: Bool
inDisabled} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = forall a. Show a => Text -> a -> Text
dropLhsComment Text
l Int
lineNumber forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Disabled{}
    | -- Comment on a single line.
      Text
l Text -> Text -> Bool
`startsWith` Text
lhsCommentSpace =
        let l' :: Text
l' = Text -> Text -> Text
dropLen Text
lhsCommentSpace Text
l
         in if
                | -- disable
                  Text
l' Text -> Text -> Bool
`startsWith` Mode Internal
_disable ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inDisabled:State :: Bool
inDisabled = Bool
True} [(Int, Text)]
ls ([Text] -> Token
Disabled [] forall a. a -> [a] -> [a]
: Tokens
result)
                | Bool
otherwise ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                      Config Internal -> Format -> Token -> Text -> Int -> Tokens
parseLineToToken Config Internal
conf Format
Lhs Token
r Text
l' Int
lineNumber forall a. Semigroup a => a -> a -> a
<> Tokens
rs
    | -- start of a snippet
      Text
l Text -> Text -> Bool
`startsWith` Text
lhsHsCodeSpace =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inHaskellCode:State :: Bool
inHaskellCode = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          let l' :: Text
l' = Text -> Text -> Text
dropLen Text
lhsHsCodeSpace Text
l
           in case Token
r of
                HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = Text
l' forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                Token
_ -> HaskellCode{$sel:manyLines:Indent :: [Text]
manyLines = [Text
l']} forall a. a -> [a] -> [a]
: Tokens
result
    | Bool
inText =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inText :: Bool
$sel:inText:State :: Bool
inText} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          case Token
r of
            Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs
            Token
_ -> Token -> Tokens
errorExpected Text{}
    | -- a blank line
      Text -> Bool
T.null Text
l =
        case Token
r of
          Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines} -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inComment :: Bool
$sel:inComment:State :: Bool
inComment} [(Int, Text)]
ls (Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs)
          Token
_ -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
    | -- start of a text
      Bool
otherwise =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
result
   where
    errorExpected :: Token -> Tokens
errorExpected = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res

-- | Convert 'Tokens' to @Markdown@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
--
-- - These are the relations between document blocks and tokens when the default 'Config' values are used.
--
--     - 'Indent' ~ @'<!-- LIMA_INDENT N --\>'@, where @N@ is an 'Int'.
--     - 'Dedent' ~ @'<!-- LIMA_DEDENT --\>'@.
--     - 'Disabled' ~ a multiline comment
--       starting with @'<!-- LIMA_DISABLE\\n'@
--       and ending with @'\\nLIMA_ENABLE --\>'@.
--
--         @
--         <!-- LIMA_DISABLE
--         a4 = 4
--         a2 = 2
--         LIMA_ENABLE --\>
--         @
--
--     - 'CommentSingleLine' ~ a line starting with @'<!-- '@ and ending with @' -->'@.
--
--         @
--         <!-- line -->
--         @
--
--     - 'Comment' ~ a multiline comment starting with @'<!-- {text}'@, where @{text}@ is nonempty text.
--
--         @
--         <!-- line 1
--         line 2
--         --\>
--         @
--
--         - Consecutive 'Comment's are merged into a single 'Comment'.
--
--     - 'HaskellCode' ~ possibly indented block starting with @\'```haskell\'@ and ending with @'```'@.
--
--         @
--           ```haskell
--             a4 = 2
--           ```
--         @
--
--     - 'Text' ~ other lines.
--
-- === __Example__
--
-- >>> pp $ mdFromTokens def exampleNonTexTokens
--    <!-- LIMA_INDENT 3 -->
-- <BLANKLINE>
-- <!-- LIMA_DISABLE
-- <BLANKLINE>
-- -- What's the answer?
-- <BLANKLINE>
-- LIMA_ENABLE -->
-- <BLANKLINE>
--  <!-- LIMA_INDENT 1 -->
-- <BLANKLINE>
--   <!-- LIMA_INDENT 2 -->
-- <BLANKLINE>
-- - Intermediate results
-- <BLANKLINE>
--   ```haskell
--   a = const 3
--   b = a 4
--   ```
-- <BLANKLINE>
-- <!-- LIMA_DEDENT -->
-- <BLANKLINE>
-- ```haskell
-- answer = b * 14
-- ```
-- <BLANKLINE>
-- <!-- Hello from comments,
-- <BLANKLINE>
-- world!
-- -->
-- <BLANKLINE>
-- <!-- Comment on a single line. -->
-- <BLANKLINE>
-- Hello from text,
-- <BLANKLINE>
-- world!
mdFromTokens :: Config User -> Tokens -> T.Text
mdFromTokens :: Config User -> Tokens -> Text
mdFromTokens = (Config User -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
mdFromTokens'

-- | Convert 'Tokens' to @Haskell@ code.
--
-- Each 'Token' becomes a 'T.Text' in a list.
--
-- These 'T.Text's are concatenated in 'mdFromTokens'.
mdFromTokens' :: Config User -> Tokens -> [T.Text]
mdFromTokens' :: Config User -> Tokens -> [Text]
mdFromTokens' (Config User -> Config Internal
toConfigInternal -> Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Tokens
blocks =
  forall a. a -> [a] -> [a]
intersperse Text
T.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
0 Tokens
blocks []
 where
  fromTokens :: Int -> Tokens -> [[T.Text]] -> [[T.Text]]
  fromTokens :: Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
_ [] [[Text]]
res = [[Text]]
res
  fromTokens Int
curIndent (Token
b : Tokens
bs) [[Text]]
res =
    case Token
b of
      Indent{Int
n :: Int
$sel:n:Indent :: Token -> Int
..} -> Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
n Tokens
bs ([Int -> Text -> Text
indentN Int
n forall a b. (a -> b) -> a -> b
$ Text
mdCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
n) forall a. Semigroup a => a -> a -> a
<> Text
mdCommentCloseSpace] forall a. a -> [a] -> [a]
: [[Text]]
res)
      Token
Dedent -> Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
0 Tokens
bs ([Text
mdCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_dedent forall a. Semigroup a => a -> a -> a
<> Text
mdCommentCloseSpace] forall a. a -> [a] -> [a]
: [[Text]]
res)
      Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
0 Tokens
bs ([[Mode Internal
_enable forall a. Semigroup a => a -> a -> a
<> Text
mdCommentCloseSpace]] forall a. Semigroup a => a -> a -> a
<> [[Text]
manyLines] forall a. Semigroup a => a -> a -> a
<> [[Text
mdCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_disable]] forall a. Semigroup a => a -> a -> a
<> [[Text]]
res)
      HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
curIndent Tokens
bs ((Int -> Text -> Text
indentN Int
curIndent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Mode Internal
_mdHaskellCodeEnd] forall a. Semigroup a => a -> a -> a
<> [Text]
manyLines forall a. Semigroup a => a -> a -> a
<> [Mode Internal
_mdHaskellCodeStart])) forall a. a -> [a] -> [a]
: [[Text]]
res)
      Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
curIndent Tokens
bs (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines forall a. a -> [a] -> [a]
: [[Text]]
res)
      Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines} ->
        Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
curIndent Tokens
bs forall a b. (a -> b) -> a -> b
$
          [Text
mdCommentClose] forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Text
someLines forall a. Semigroup a => a -> a -> a
<> [Text
mdCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Text
someLines] forall a. a -> [a] -> [a]
: [[Text]]
res
      CommentSingleLine{Text
someLine :: Text
$sel:someLine:Indent :: Token -> Text
someLine} ->
        Int -> Tokens -> [[Text]] -> [[Text]]
fromTokens Int
curIndent Tokens
bs forall a b. (a -> b) -> a -> b
$
          [Text
mdCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Text
someLine forall a. Semigroup a => a -> a -> a
<> Text
mdCommentCloseSpace] forall a. a -> [a] -> [a]
: [[Text]]
res

-- | Convert 'Tokens' to @Markdown@ code.
--
-- Inverse of 'mdFromTokens'.
--
-- >>> (mdToTokens def $ mdFromTokens def exampleNonTexTokens) == exampleNonTexTokens
-- True
mdToTokens :: Config User -> T.Text -> Tokens
mdToTokens :: Config User -> Text -> Tokens
mdToTokens (Config User -> Config Internal
toConfigInternal -> conf :: Config Internal
conf@Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkToTokens State -> [(Int, Text)] -> Tokens -> Tokens
toTokens Text
xs
  toTokens :: State -> [(Int, T.Text)] -> Tokens -> Tokens
  toTokens :: State -> [(Int, Text)] -> Tokens -> Tokens
toTokens State{Bool
inComment :: Bool
inDisabled :: Bool
inHaskellCode :: Bool
inText :: Bool
$sel:inComment:State :: State -> Bool
$sel:inDisabled:State :: State -> Bool
$sel:inHaskellCode:State :: State -> Bool
$sel:inText:State :: State -> Bool
..} ((Int
lineNumber, Text
l) : [(Int, Text)]
ls) res :: Tokens
res@(Token
r : Tokens
rs)
    | Bool
inDisabled =
        -- enable
        if Text
l Text -> Text -> Bool
`startsWith` (Mode Internal
_enable forall a. Semigroup a => a -> a -> a
<> Text
mdCommentCloseSpace)
          then State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
          else -- copy lines
          State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inDisabled :: Bool
$sel:inDisabled:State :: Bool
inDisabled} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
            case Token
r of
              Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = Text
l forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
              Token
_ -> Token -> Tokens
errorExpected Disabled{}
    | Bool
inComment =
        if Text
l Text -> Text -> Bool
`startsWith` Text
mdCommentClose
          then -- finish comment
            State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
          else -- copy lines
          State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inComment :: Bool
$sel:inComment:State :: Bool
inComment} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
            case Token
r of
              Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> (Token
r{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs)
              Token
_ -> Token -> Tokens
errorExpected Comment{}
    | Bool
inHaskellCode =
        if Text -> Text
stripSpaces Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_mdHaskellCodeEnd
          then -- finish snippet
            State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
          else -- copy lines
          State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inHaskellCode :: Bool
$sel:inHaskellCode:State :: Bool
inHaskellCode} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
            case Token
r of
              HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = Text
l forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
              Token
_ -> Token -> Tokens
errorExpected HaskellCode{}
    -- Doesn't matter if in text

    | -- Comment on a single line.
      Text -> Bool
isMdComment Text
l =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Config Internal -> Format -> Token -> Text -> Int -> Tokens
parseLineToToken Config Internal
conf Format
Md Token
r (Text -> Text
stripMdComment Text
l) Int
lineNumber forall a. Semigroup a => a -> a -> a
<> Tokens
rs
    | -- start of a comment on multiple lines
      Text
l Text -> Text -> Bool
`startsWith` Text
mdCommentOpenSpace =
        let l' :: Text
l' = Text -> Text -> Text
dropLen Text
mdCommentOpenSpace Text
l
         in if
                | Text
l' forall a. Eq a => a -> a -> Bool
== Mode Internal
_disable ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inDisabled:State :: Bool
inDisabled = Bool
True} [(Int, Text)]
ls ([Text] -> Token
Disabled [] forall a. a -> [a] -> [a]
: Tokens
res)
                | Text -> Bool
T.null Text
l' -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a1 a2. Show a1 => a1 -> a2
errorEmptyCommentAt Int
lineNumber
                | Bool
otherwise ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inComment:State :: Bool
inComment = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                      NonEmpty Text -> Token
Comment (Text
l' forall a. a -> [a] -> NonEmpty a
:| []) forall a. a -> [a] -> [a]
: Tokens
res
    | -- start of a haskell snippet
      Text -> Text
stripSpaces Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_mdHaskellCodeStart =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inHaskellCode:State :: Bool
inHaskellCode = Bool
True} [(Int, Text)]
ls ([Text] -> Token
HaskellCode [] forall a. a -> [a] -> [a]
: Tokens
res)
    -- Again matters if in a text
    | Bool
inText =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inText :: Bool
$sel:inText:State :: Bool
inText} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          case Token
r of
            Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs
            Token
_ -> Token -> Tokens
errorExpected Text{}
    | Bool
otherwise =
        if
            | Text -> Bool
T.null Text
l ->
                -- skip
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
            | Bool
otherwise ->
                -- start a text
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
res
   where
    errorExpected :: Token -> Tokens
errorExpected = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res

-- | Convert 'Tokens' to @Haskell@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
--
-- - These are the relations between 'Tokens' and document blocks when the default 'Config' values are used.
--
--     - 'Indent' ~ @'{- LIMA_INDENT N -}'@ where @N@ is an 'Int'.
--     - 'Dedent' ~ @'{- LIMA_DEDENT -}'@.
--     - 'Disabled' ~ @'{- LIMA_DISABLE -}'@ and @'{- LIMA_ENABLE -}'@ and lines between them.
--
--         @
--         {- LIMA_DISABLE -}
--
--         disabled
--
--         {- LIMA_ENABLE -}
--         @
--
--     - 'Text' ~ a multiline comment starting with @'{-\\n'@ and ending with @'\\n-}'@.
--
--         @
--         {-
--         line 1
--         -}
--         @
--
--         - Consecutive 'Text's are merged into a single 'Text'.
--         - There must be at list one nonempty line inside this comment.
--
--     - 'CommentSingleLine' ~ a multiline comment on a single line.
--
--         @
--         {- line -}
--         @
--
--     - 'Comment' ~ a multiline comment starting with @'{- TEXT'@, where @TEXT@ is nonempty text, and ending with @\\n-}@
--
--         @
--         {- line 1
--         line 2
--         -}
--         @
--
--         - Consecutive 'Comment's are merged into a single 'Comment'.
--
--     - 'HaskellCode' ~ other lines.
--
-- === __Example__
--
-- >>> pp $ hsFromTokens def exampleNonTexTokens
-- {- LIMA_INDENT 3 -}
-- <BLANKLINE>
-- {- LIMA_DISABLE -}
-- <BLANKLINE>
-- -- What's the answer?
-- <BLANKLINE>
-- {- LIMA_ENABLE -}
-- <BLANKLINE>
-- {- LIMA_INDENT 1 -}
-- <BLANKLINE>
-- {- LIMA_INDENT 2 -}
-- <BLANKLINE>
-- {-
-- - Intermediate results
-- -}
-- <BLANKLINE>
-- a = const 3
-- b = a 4
-- <BLANKLINE>
-- {- LIMA_DEDENT -}
-- <BLANKLINE>
-- answer = b * 14
-- <BLANKLINE>
-- {- Hello from comments,
-- <BLANKLINE>
-- world!
-- -}
-- <BLANKLINE>
-- {- Comment on a single line. -}
-- <BLANKLINE>
-- {-
-- Hello from text,
-- <BLANKLINE>
-- world!
-- -}
hsFromTokens :: Config User -> Tokens -> T.Text
hsFromTokens :: Config User -> Tokens -> Text
hsFromTokens = (Config User -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
hsFromTokens'

-- | Convert 'Tokens' to @Haskell@ code.
--
-- Each 'Token' becomes a 'T.Text' in a list.
--
-- These 'T.Text's are concatenated in 'hsFromTokens'.
hsFromTokens' :: Config User -> Tokens -> [T.Text]
hsFromTokens' :: Config User -> Tokens -> [Text]
hsFromTokens' (Config User -> Config Internal
toConfigInternal -> Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Tokens
blocks =
  forall a. a -> [a] -> [a]
intersperse Text
T.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens -> [[Text]] -> [[Text]]
toHs Tokens
blocks []
 where
  toHs :: Tokens -> [[T.Text]] -> [[T.Text]]
  toHs :: Tokens -> [[Text]] -> [[Text]]
toHs [] [[Text]]
res = [[Text]]
res
  toHs (Token
b : Tokens
bs) [[Text]]
res =
    Tokens -> [[Text]] -> [[Text]]
toHs Tokens
bs forall a b. (a -> b) -> a -> b
$
      case Token
b of
        Indent{Int
n :: Int
$sel:n:Indent :: Token -> Int
..} -> [Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
T.show Int
n) forall a. Semigroup a => a -> a -> a
<> Text
hsCommentCloseSpace] forall a. a -> [a] -> [a]
: [[Text]]
res
        Token
Dedent -> [Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_dedent forall a. Semigroup a => a -> a -> a
<> Text
hsCommentCloseSpace] forall a. a -> [a] -> [a]
: [[Text]]
res
        Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} ->
          [[Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_enable forall a. Semigroup a => a -> a -> a
<> Text
hsCommentCloseSpace]]
            forall a. Semigroup a => a -> a -> a
<> [[Text]
manyLines]
            forall a. Semigroup a => a -> a -> a
<> [[Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_disable forall a. Semigroup a => a -> a -> a
<> Text
hsCommentCloseSpace]]
            forall a. Semigroup a => a -> a -> a
<> [[Text]]
res
        HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> [Text]
manyLines forall a. a -> [a] -> [a]
: [[Text]]
res
        Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> [Text
hsCommentClose] forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines forall a. Semigroup a => a -> a -> a
<> [Text
hsCommentOpen] forall a. a -> [a] -> [a]
: [[Text]]
res
        Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines} ->
          [Text
hsCommentClose] forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Text
someLines forall a. Semigroup a => a -> a -> a
<> [Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Text
someLines] forall a. a -> [a] -> [a]
: [[Text]]
res
        CommentSingleLine{Text
someLine :: Text
$sel:someLine:Indent :: Token -> Text
someLine} ->
          [Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> Text
someLine forall a. Semigroup a => a -> a -> a
<> Text
hsCommentCloseSpace] forall a. a -> [a] -> [a]
: [[Text]]
res

-- | Convert 'Tokens' to @Haskell@ code.
--
-- Inverse of 'hsFromTokens'.
--
-- >>> (hsToTokens def $ hsFromTokens def exampleNonTexTokens) == exampleNonTexTokens
-- True
hsToTokens :: Config User -> T.Text -> Tokens
hsToTokens :: Config User -> Text -> Tokens
hsToTokens (Config User -> Config Internal
toConfigInternal -> conf :: Config Internal
conf@Config{Mode Internal
_lhsSingleLineCommentStart :: Mode Internal
_texSingleLineCommentStart :: Mode Internal
_texHaskellCodeEnd :: Mode Internal
_texHaskellCodeStart :: Mode Internal
_mdHaskellCodeEnd :: Mode Internal
_mdHaskellCodeStart :: Mode Internal
_dedent :: Mode Internal
_indent :: Mode Internal
_enable :: Mode Internal
_disable :: Mode Internal
$sel:_lhsSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texSingleLineCommentStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkToTokens State -> [(Int, Text)] -> Tokens -> Tokens
toTokens Text
xs
  toTokens :: State -> [(Int, T.Text)] -> Tokens -> Tokens
  toTokens :: State -> [(Int, Text)] -> Tokens -> Tokens
toTokens State{Bool
inComment :: Bool
inDisabled :: Bool
inHaskellCode :: Bool
inText :: Bool
$sel:inComment:State :: State -> Bool
$sel:inDisabled:State :: State -> Bool
$sel:inHaskellCode:State :: State -> Bool
$sel:inText:State :: State -> Bool
..} ((Int
lineNumber, Text
l) : [(Int, Text)]
ls) res :: Tokens
res@(Token
r : Tokens
rs)
    | Bool
inText =
        if
            | Text
l Text -> Text -> Bool
`startsWith` Text
hsCommentClose ->
                case Token
r of
                  Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines}
                    | [Text] -> [Text]
stripEmpties (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines) forall a. Eq a => a -> a -> Bool
== [] ->
                        forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
                          (String
"No text in a 'Text' token ending at line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
lineNumber forall a. Semigroup a => a -> a -> a
<> String
".\n\n")
                            forall a. Semigroup a => a -> a -> a
<> String
"Please, write some text between '{-\\n' and '\\n-}'."
                    | Bool
otherwise -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
                  Token
_ -> Token -> Tokens
errorExpected Text{}
            | Bool
otherwise ->
                -- copy lines
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens (forall a. Default a => a
def{Bool
inText :: Bool
$sel:inText:State :: Bool
inText}) [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> (Token
r{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Text{}
    | Bool
inDisabled =
        if
            | Text -> Bool
isHsComment Text
l Bool -> Bool -> Bool
&& Text -> Text
stripHsComment Text
l Text -> Text -> Bool
`startsWith` Mode Internal
_enable ->
                -- enable
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
            | Bool
otherwise ->
                -- copy lines
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inDisabled :: Bool
$sel:inDisabled:State :: Bool
inDisabled} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = Text
l forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Disabled{}
    | Bool
inComment =
        if
            | -- finish comment
              Text
l Text -> Text -> Bool
`startsWith` Text
hsCommentClose ->
                case Token
r of
                  Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines}
                    | [Text] -> [Text]
stripEmpties (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines) forall a. Eq a => a -> a -> Bool
== [] ->
                        forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
                          (String
"No text in a 'Comment' token ending at line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
lineNumber forall a. Semigroup a => a -> a -> a
<> String
".\n\n")
                            forall a. Semigroup a => a -> a -> a
<> String
"Please, write some text between '{- ' and '\\n-}'."
                    | Bool
otherwise -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
                  Token
_ -> Token -> Tokens
errorExpected Comment{}
            | -- copy lines
              Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inComment :: Bool
$sel:inComment:State :: Bool
inComment} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> (Token
r{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Comment{}
    -- Doesn't matter if in a snippet

    | -- start of text
      Text
l forall a. Eq a => a -> a -> Bool
== Text
hsCommentOpen =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls (Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
T.empty forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
res)
    | -- Comment on a single line.
      Text -> Bool
isHsComment Text
l =
        let l' :: Text
l' = Text -> Text
stripHsComment Text
l
         in if
                | Text
l' Text -> Text -> Bool
`startsWith` Mode Internal
_disable -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inDisabled:State :: Bool
inDisabled = Bool
True} [(Int, Text)]
ls ([Text] -> Token
Disabled [] forall a. a -> [a] -> [a]
: Tokens
res)
                | Bool
otherwise -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Config Internal -> Format -> Token -> Text -> Int -> Tokens
parseLineToToken Config Internal
conf Format
Hs Token
r Text
l' Int
lineNumber forall a. Semigroup a => a -> a -> a
<> Tokens
rs
    | -- start of a comment on multiple lines
      Text
l Text -> Text -> Bool
`startsWith` Text
hsCommentOpenSpace =
        let l' :: Text
l' = Text -> Text -> Text
dropLen Text
hsCommentOpenSpace Text
l
         in if
                | Text -> Bool
T.null Text
l' -> forall a1 a2. Show a1 => a1 -> a2
errorEmptyCommentAt Int
lineNumber
                | Bool
otherwise ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inComment:State :: Bool
inComment = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                      NonEmpty Text -> Token
Comment (Text
l' forall a. a -> [a] -> NonEmpty a
:| []) forall a. a -> [a] -> [a]
: Tokens
res
    -- Again matters if in a snippet
    | Bool
inHaskellCode =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inHaskellCode :: Bool
$sel:inHaskellCode:State :: Bool
inHaskellCode} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          case Token
r of
            HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> HaskellCode{$sel:manyLines:Indent :: [Text]
manyLines = Text
l forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs
            Token
_ -> Token -> Tokens
errorExpected HaskellCode{}
    | -- a blank line
      Text -> Bool
T.null Text
l =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
    | -- start of a snippet
      Bool
otherwise =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inHaskellCode:State :: Bool
inHaskellCode = Bool
True} [(Int, Text)]
ls ([Text] -> Token
HaskellCode [Text
l] forall a. a -> [a] -> [a]
: Tokens
res)
   where
    errorExpected :: Token -> Tokens
errorExpected = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res