-- |
-- == 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 Lima.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 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.String.Interpolate (i)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Lens.Micro (non, to, (&), (?~), (^.))
import Lens.Micro.TH (makeLenses)
import Lima.Converter.Internal
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)]
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)]
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 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
    [ 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 :: Int -> Token -> Token -> a
errorExpectedToken :: forall a. Int -> Token -> Token -> a
errorExpectedToken Int
lineNumber Token
lastToken Token
expectedToken =
  forall a. HasCallStack => String -> a
error
    [i|
      Wrong state at line: #{lineNumber}.

      Expected last token: #{constructorName expectedToken}.

      Got last token: #{lastToken}.

      Please, create an issue in the package repository.
    |]

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 (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 Text
l Text -> Text -> Bool
`startsWith` (Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal
_enable)
          then State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
          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 = 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
          then 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)
          else 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
              then 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)
              else
                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 a. Int -> Token -> Token -> a
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 -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
lhsFromTokens'

-- | 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)
          then State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
          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 = 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
              then 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)
              else
                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 a. Int -> Token -> Token -> a
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
          then -- skip
            State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
          else -- 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 a. Int -> Token -> Token -> a
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
          then case Token
r of
            Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines}
              | forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> [Text]
stripEmpties (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines)) ->
                  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{}
          else -- 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
          then -- enable
            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 -- finish comment
        Text
l Text -> Text -> Bool
`startsWith` Text
hsCommentClose
          then case Token
r of
            Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines}
              | forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> [Text]
stripEmpties (forall a. NonEmpty a -> [a]
toList NonEmpty Text
someLines)) ->
                  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{}
          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{}
    -- 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
              then 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)
              else 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'
              then forall a1 a2. Show a1 => a1 -> a2
errorEmptyCommentAt Int
lineNumber
              else
                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 a. Int -> Token -> Token -> a
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res