-- |
-- == 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 'Token's. 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'.
module Converter (
  -- * Config
  Mode,
  User,
  Internal,
  Config (..),
  def,
  toInternalConfig,
  fromInternalConfig,

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

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

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

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

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

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

  -- * Examples
  exampleNonTexTokens',
  exampleNonTexTokens,
  exampleTexTokens,

  -- * Helpers
  stripEmpties,
  PrettyPrint (..),
) where

import Data.Char (isAlpha)
import Data.Data (Data (toConstr), showConstr)
import Data.Default (Default (def))
import Data.List (dropWhileEnd, intersperse)
import Data.List.NonEmpty (NonEmpty ((:|)), fromList, toList, (<|))
import Data.Text qualified as T
import GHC.Generics (Generic)
import Lens.Micro (non, (&), (?~), (^.), (^?))
import Lens.Micro.TH (makeLenses)
import Text.Read (readMaybe)
import Text.Show qualified as T

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

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

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

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

-- | Configuration of tag names.
--
-- Here are the default names.
--
-- >>> pp (def :: Config User)
-- Config {
--   _disable = Just "LIMA_DISABLE",
--   _enable = Just "LIMA_ENABLE",
--   _indent = Just "LIMA_INDENT",
--   _dedent = Just "LIMA_DEDENT",
--   _mdHaskellCodeStart = Just "```haskell",
--   _mdHaskellCodeEnd = Just "```",
--   _texHaskellCodeStart = Just "\\begin{code}",
--   _texHaskellCodeEnd = Just "\\end{code}"
-- }
--
-- It's possible to override these names.
--
-- >>> pp ((def :: Config User) & disable ?~ "off" & enable ?~ "on" & indent ?~ "indent" & dedent ?~ "dedent")
-- Config {
--   _disable = Just "off",
--   _enable = Just "on",
--   _indent = Just "indent",
--   _dedent = Just "dedent",
--   _mdHaskellCodeStart = Just "```haskell",
--   _mdHaskellCodeEnd = Just "```",
--   _texHaskellCodeStart = Just "\\begin{code}",
--   _texHaskellCodeEnd = Just "\\end{code}"
-- }
data Config (a :: Mode') = Config
  { forall (a :: Mode'). Config a -> Mode a Text
_disable :: Mode a T.Text
  -- ^
  -- Make parser ignore tags and just copy the following lines verbatim.
  --
  -- Set indentation to @0@.
  , forall (a :: Mode'). Config a -> Mode a Text
_enable :: Mode a T.Text
  -- ^ Stop parser from ignoring tags.
  , forall (a :: Mode'). Config a -> Mode a Text
_indent :: Mode a T.Text
  -- ^ Set code indentation to a given 'Int'.
  , forall (a :: Mode'). Config a -> Mode a Text
_dedent :: Mode a T.Text
  -- ^ Set code indentation to @0@.
  , forall (a :: Mode'). Config a -> Mode a Text
_mdHaskellCodeStart :: Mode a T.Text
  -- ^ Mark the start of a @Haskell@ code block in @Markdown@.
  , forall (a :: Mode'). Config a -> Mode a Text
_mdHaskellCodeEnd :: Mode a T.Text
  -- ^ Mark the end of a @Haskell@ code block in @Markdown@.
  , forall (a :: Mode'). Config a -> Mode a Text
_texHaskellCodeStart :: Mode a T.Text
  -- ^ Mark the start of a @Haskell@ code block in @TeX@.
  , forall (a :: Mode'). Config a -> Mode a Text
_texHaskellCodeEnd :: Mode a T.Text
  -- ^ Mark the end of a @Haskell@ code block in @TeX@.
  }
  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)

newtype Pretty a = Pretty String

instance Show a => Show (Pretty a) where
  show :: Pretty a -> String
  show :: Pretty a -> [Char]
show (Pretty [Char]
s) = [Char]
s

-- >>> lhsFromTokens def ex
-- "line 1\nline2\n\n% line 3\n\n% line 4\n"

-- | A class for prettyprinting data on multiple lines in haddocks.
--
-- It's not meant to be used outside of this library.
class Show a => PrettyPrint a where
  pp :: a -> Pretty String

instance PrettyPrint String where
  pp :: String -> Pretty String
  pp :: [Char] -> Pretty [Char]
pp = forall a. [Char] -> Pretty a
Pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n')

instance PrettyPrint T.Text where
  pp :: T.Text -> Pretty String
  pp :: Text -> Pretty [Char]
pp = forall a. PrettyPrint a => a -> Pretty [Char]
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

instance PrettyPrint (Config User) where
  pp :: Config User -> Pretty String
  pp :: Config User -> Pretty [Char]
pp (Config Internal -> Config User
fromInternalConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config User -> Config Internal
toInternalConfig -> Config User
config) =
    forall a. PrettyPrint a => a -> Pretty [Char]
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
== [Char]
" _" -> [Char]
"\n  "
                  | [Char
a, Char
b] forall a. Eq a => a -> a -> Bool
== [Char]
"{_" -> [Char]
"{\n  "
                  | Bool
otherwise -> [Char
a]
          )
          forall a b. (a -> b) -> a -> b
$ (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Show a => a -> [Char]
show Config User
config) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Config User
config))
      )
        forall a. Semigroup a => a -> a -> a
<> [Char]
"\n}"

instance Default (Config Internal) where
  def :: Config Internal
  def :: Config Internal
def = Config{Text
_texHaskellCodeEnd :: Text
_texHaskellCodeStart :: Text
_mdHaskellCodeEnd :: Text
_mdHaskellCodeStart :: Text
_dedent :: Text
_indent :: Text
_enable :: Text
_disable :: Text
$sel:_texHaskellCodeEnd:Config :: Mode Internal Text
$sel:_texHaskellCodeStart:Config :: Mode Internal Text
$sel:_mdHaskellCodeEnd:Config :: Mode Internal Text
$sel:_mdHaskellCodeStart:Config :: Mode Internal Text
$sel:_dedent:Config :: Mode Internal Text
$sel:_indent:Config :: Mode Internal Text
$sel:_enable:Config :: Mode Internal Text
$sel:_disable:Config :: Mode Internal Text
..}
   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{code}"
    _texHaskellCodeEnd :: Text
_texHaskellCodeEnd = Text
"\\end{code}"

-- | Make a user 'Config' with default values from an internal 'Config'.
fromInternalConfig :: Config Internal -> Config User
fromInternalConfig :: Config Internal -> Config User
fromInternalConfig Config Internal
conf = Config{Maybe Text
_texHaskellCodeEnd :: Maybe Text
_texHaskellCodeStart :: Maybe Text
_mdHaskellCodeEnd :: Maybe Text
_mdHaskellCodeStart :: Maybe Text
_dedent :: Maybe Text
_indent :: Maybe Text
_enable :: Maybe Text
_disable :: Maybe Text
$sel:_texHaskellCodeEnd:Config :: Mode User Text
$sel:_texHaskellCodeStart:Config :: Mode User Text
$sel:_mdHaskellCodeEnd:Config :: Mode User Text
$sel:_mdHaskellCodeStart:Config :: Mode User Text
$sel:_dedent:Config :: Mode User Text
$sel:_indent:Config :: Mode User Text
$sel:_enable:Config :: Mode User Text
$sel:_disable:Config :: Mode User Text
..}
 where
  _disable :: Maybe Text
_disable = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
disable
  _enable :: Maybe Text
_enable = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
enable
  _indent :: Maybe Text
_indent = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
indent
  _dedent :: Maybe Text
_dedent = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
dedent
  _mdHaskellCodeStart :: Maybe Text
_mdHaskellCodeStart = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
mdHaskellCodeStart
  _mdHaskellCodeEnd :: Maybe Text
_mdHaskellCodeEnd = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
mdHaskellCodeEnd
  _texHaskellCodeStart :: Maybe Text
_texHaskellCodeStart = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
texHaskellCodeStart
  _texHaskellCodeEnd :: Maybe Text
_texHaskellCodeEnd = Config Internal
conf forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (a :: Mode'). Lens' (Config a) (Mode a Text)
texHaskellCodeEnd

instance Default (Config User) where
  def :: Config User
  def :: Config User
def = Config Internal -> Config User
fromInternalConfig forall a. Default a => a
def

-- | Convert a user 'Config' to an internal 'Config' with user-supplied values.
toInternalConfig :: Config User -> Config Internal
toInternalConfig :: Config User -> Config Internal
toInternalConfig Config User
conf =
  Config
    { $sel:_disable:Config :: Mode Internal Text
_disable = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
disable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_disable
    , $sel:_enable:Config :: Mode Internal Text
_enable = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
enable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_enable
    , $sel:_indent:Config :: Mode Internal Text
_indent = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_indent
    , $sel:_dedent:Config :: Mode Internal Text
_dedent = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
dedent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_dedent
    , $sel:_mdHaskellCodeStart:Config :: Mode Internal Text
_mdHaskellCodeStart = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
mdHaskellCodeStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_mdHaskellCodeStart
    , $sel:_mdHaskellCodeEnd:Config :: Mode Internal Text
_mdHaskellCodeEnd = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
mdHaskellCodeEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_mdHaskellCodeEnd
    , $sel:_texHaskellCodeStart:Config :: Mode Internal Text
_texHaskellCodeStart = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
texHaskellCodeStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_texHaskellCodeStart
    , $sel:_texHaskellCodeEnd:Config :: Mode Internal Text
_texHaskellCodeEnd = Config User
conf forall s a. s -> Getting a s a -> a
^. forall (a :: Mode'). Lens' (Config a) (Mode a Text)
texHaskellCodeEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non Text
_texHaskellCodeEnd
    }
 where
  Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..} = forall a. Default a => a
def @(Config Internal)

-- | A format of a document.
data Format
  = -- | @Haskell@
    Hs
  | -- | @Literate Haskell@
    Lhs
  | -- | @Markdown@
    Md
  | -- | @TeX@
    TeX

-- | Internal representation of a document.
--
-- A printer processes a list of 'Token's one by one.
--
-- A 'Token' can have:
--
-- - Action - how this 'Token' affects the subsequent 'Tokens'.
-- - Target - a type of 'Token's that are affected by this 'Token'.
-- - Range - the nearest 'Token' until which this 'Token' affects the subsequent 'Token's.
data Token
  = -- |
    -- - Action: set indentation to @n@.
    --
    -- - Target: 'HaskellCode'.
    --
    -- - Range: until 'Indent', 'Dedent', or 'Disabled'.
    Indent {Token -> Int
n :: Int}
  | -- |
    -- - Action: set indentation to @0@.
    --
    -- - Target: 'HaskellCode'.
    --
    -- - Range: until 'Indent', 'Dedent', or 'Disabled'.
    Dedent
  | -- | A block that should be invisible when rendered outside of @.hs@.
    --
    -- - Action: set indentation to @0@.
    --
    -- - Target: 'HaskellCode'.
    --
    -- - Range: until '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}
  deriving (Int -> Token -> ShowS
Tokens -> ShowS
Token -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: Tokens -> ShowS
$cshowList :: Tokens -> ShowS
show :: Token -> [Char]
$cshow :: Token -> [Char]
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 [Char]
pp Tokens
ts =
    forall a. [Char] -> 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 -> [Char]
",\n  "
                  | Char
a forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
b -> [Char]
"[\n  "
                  | Bool
otherwise -> [Char
a]
          )
          forall a b. (a -> b) -> a -> b
$ (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Show a => a -> [Char]
show Tokens
ts) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Tokens
ts))
      )
        forall a. Semigroup a => a -> a -> a
<> [Char]
"\n]"

-- | 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!" :| []},
--   Text {someLines = "world!" :| ["Hello from text,"]},
--   Text {someLines = "here!" :| ["And from"]}
-- ]
--
-- >>> 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,"]},
--   Text {someLines = "here!" :| ["And from","","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 (t1 :: Token
t1@Comment{} : t2 :: Token
t2@Comment{} : Tokens
ts) = Tokens -> Tokens
mergeTokens forall a b. (a -> b) -> a -> b
$ Comment{$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 (Token
t : Tokens
ts) = Token
t forall a. a -> [a] -> [a]
: Tokens -> Tokens
mergeTokens Tokens
ts
mergeTokens Tokens
ts = Tokens
ts

-- | 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!" :| []},
--   Text {someLines = "world!" :| ["Hello from text,"]},
--   Text {someLines = "here!" :| ["And from"]}
-- ]
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
:| [])
  , NonEmpty Text -> Token
Text (Text
"world!" forall a. a -> [a] -> NonEmpty a
:| [Text
"Hello from text,"])
  , NonEmpty Text -> Token
Text (Text
"here!" forall a. a -> [a] -> NonEmpty a
:| [Text
"And from"])
  ]

-- | 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,"]},
--   Text {someLines = "here!" :| ["And from","","world!","Hello from text,"]}
-- ]
exampleNonTexTokens :: Tokens
exampleNonTexTokens :: Tokens
exampleNonTexTokens = Tokens -> Tokens
normalizeTokens Tokens
exampleNonTexTokens'

-- | 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

-- | 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

-- | Escaped hash character
escapedHash :: T.Text
escapedHash :: Text
escapedHash = Text
"\\#"

-- | Hash character
hash :: T.Text
hash :: Text
hash = Text
"#"

-- | Drop a prefix of a line with length of a given line
dropLen :: T.Text -> T.Text -> T.Text
dropLen :: Text -> Text -> Text
dropLen Text
x Text
y = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
x) Text
y

-- | Check if a list starts with a given list
startsWith :: T.Text -> T.Text -> Bool
startsWith :: Text -> Text -> Bool
startsWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isPrefixOf

-- | Check if a list ends with a given list
endsWith :: T.Text -> T.Text -> Bool
endsWith :: Text -> Text -> Bool
endsWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isSuffixOf

-- | Drop leading spaces and drop at each end of a 'T.Text' the number of characters as in the supplied prefix and suffix.
stripEnds :: T.Text -> T.Text -> T.Text -> T.Text
stripEnds :: Text -> Text -> Text -> Text
stripEnds Text
prefix Text
suffix Text
x = Int -> Text -> Text
T.dropEnd (Text -> Int
T.length Text
suffix) (Text -> Text -> Text
dropLen Text
prefix (Text -> Text
stripSpaces Text
x))

-- | Replace "\\#" with "#" in a 'T.Text' prefix.
lhsUnescapeHash :: T.Text -> T.Text
lhsUnescapeHash :: Text -> Text
lhsUnescapeHash Text
x = if Text
x Text -> Text -> Bool
`startsWith` Text
escapedHash then Text
hash forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text
dropLen Text
escapedHash Text
x) else Text
x

-- | Replace "#" with "\\#" in a 'T.Text' prefix.
lhsEscapeHash :: T.Text -> T.Text
lhsEscapeHash :: Text -> Text
lhsEscapeHash Text
x = if Text
x Text -> Text -> Bool
`startsWith` Text
hash then Text
escapedHash forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text
dropLen Text
hash Text
x) else Text
x

-- | 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
      }

-- | '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,"]},
--   Text {someLines = "here!" :| ["And from","","world!","Hello from text,"]}
-- ]
normalizeTokens :: Tokens -> Tokens
normalizeTokens :: Tokens -> Tokens
normalizeTokens Tokens
tokens = Tokens -> Tokens
stripTokens forall a b. (a -> b) -> a -> b
$ Tokens -> Tokens
mergeTokens forall a b. (a -> b) -> a -> b
$ Tokens
tokens

-- | Compose a function from a 'T.Text' to 'Tokens'.
mkIntoTokens :: (State -> [(Int, T.Text)] -> [Token] -> [Token]) -> T.Text -> Tokens
mkIntoTokens :: (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkIntoTokens 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 to a token contents of a multiline comment written on a single line.
--
-- Merge consecutive 'Comment's
parseToken :: Config Internal -> Token -> T.Text -> Int -> Tokens
parseToken :: Config Internal -> Token -> Text -> Int -> Tokens
parseToken Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..} Token
prev Text
l Int
lineNumber
  | Text
l Text -> Text -> Bool
`startsWith` Mode Internal Text
_indent =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Expected a number at line: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
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 => [Char] -> Maybe a
readMaybe @Int (Text -> [Char]
T.unpack (Text -> Text -> Text
dropLen Mode Internal Text
_indent Text
l)))
  | Text
l forall a. Eq a => a -> a -> Bool
== Mode Internal Text
_dedent = [Token
Dedent, Token
prev]
  | Bool
otherwise =
      case Token
prev of
        Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> [Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines}]
        Token
_ -> [NonEmpty Text -> Token
Comment (Text
l forall a. a -> [a] -> NonEmpty a
:| []), Token
prev]

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

-- | Strip the given value from the beginning and the end of a list.
stripList :: Eq a => a -> [a] -> [a]
stripList :: forall a. Eq a => a -> [a] -> [a]
stripList a
x = forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== a
x)

-- | Pad a 'T.Text' with a given number of spaces
indentN :: Int -> T.Text -> T.Text
indentN :: Int -> Text -> Text
indentN Int
x Text
s = [Text] -> Text
T.concat (forall a. Int -> a -> [a]
replicate Int
x Text
" ") forall a. Semigroup a => a -> a -> a
<> Text
s

-- | 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

-- | same as 'exampleNonTexTokens', but with @TeX@-specific tags that make @Haskell@ code blocks correctly parsable.
--
-- >>> pp $ exampleTexTokens
-- [
--   Disabled {manyLines = ["-- What's the answer?"]},
--   Indent {n = 1},
--   Indent {n = 2},
--   Text {someLines = "\\begin{code}" :| ["","Intermediate results"]},
--   HaskellCode {manyLines = ["b = a 4","a = const 3"]},
--   Text {someLines = "\\end{code}" :| []},
--   Dedent,
--   Text {someLines = "\\begin{code}" :| []},
--   HaskellCode {manyLines = ["answer = b * 14"]},
--   Text {someLines = "\\end{code}" :| []},
--   Comment {someLines = "world!" :| ["","Hello from comments,"]},
--   Text {someLines = "world!" :| ["Hello from text,"]}
-- ]
exampleTexTokens :: Tokens
exampleTexTokens :: Tokens
exampleTexTokens =
  Tokens -> Tokens
normalizeTokens forall a b. (a -> b) -> a -> b
$
    [ Disabled{$sel:manyLines:Indent :: [Text]
manyLines = [Text
"-- What's the answer?"]}
    , Int -> Token
Indent Int
1
    , Int -> Token
Indent Int
2
    , Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"Intermediate results" forall a. a -> [a] -> NonEmpty a
:| []}
    , Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"\\begin{code}" forall a. a -> [a] -> NonEmpty a
:| []}
    , [Text] -> Token
HaskellCode [Text
"   b = a 4", Text
"   a = const 3"]
    , Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"\\end{code}" forall a. a -> [a] -> NonEmpty a
:| []}
    , Token
Dedent
    , Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"\\begin{code}" forall a. a -> [a] -> NonEmpty a
:| []}
    , [Text] -> Token
HaskellCode [Text
"answer = b * 14"]
    , Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"\\end{code}" forall a. a -> [a] -> NonEmpty a
:| []}
    , 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{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
"world!" forall a. a -> [a] -> NonEmpty a
:| [Text
"Hello from text,"]}
    ]

-- | Convert 'Tokens' to @TeX@ 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.
--
--     - @'% LIMA_INDENT N'@ (@N@ is an 'Int') ~ 'Indent'
--     - @'% LIMA_DEDENT'@ ~ 'Dedent'.
--     - Lines between and including @'% LIMA_DISABLE'@ and @'% LIMA_ENABLE'@ ~ 'Disabled'.
--
--     - Consecutive lines, either empty or starting with @'% '@ ~ 'Comment'.
--
--         @
--         % Hello,
--         % world!
--
--         % Hello,
--         % user!
--         @
--
--         - At least one line must have nonempty text after @'% '@
--
--     - Lines between possibly indented tags @'\\begin{code}'@ and @'\\end{code}'@ ~ 'HaskellCode'.
--
--     - Other lines ~ 'Text'.
--
-- === __Example__
--
-- >>> pp $ texFromTokens def exampleTexTokens
-- % LIMA_DISABLE
-- <BLANKLINE>
-- % -- What's the answer?
-- <BLANKLINE>
-- % LIMA_ENABLE
-- <BLANKLINE>
-- % LIMA_INDENT 1
-- <BLANKLINE>
-- % LIMA_INDENT 2
-- <BLANKLINE>
-- Intermediate results
-- <BLANKLINE>
-- \begin{code}
--   a = const 3
--   b = a 4
-- \end{code}
-- <BLANKLINE>
-- % LIMA_DEDENT
-- <BLANKLINE>
-- \begin{code}
-- answer = b * 14
-- \end{code}
-- <BLANKLINE>
-- % Hello from comments,
-- <BLANKLINE>
-- % world!
-- <BLANKLINE>
-- Hello from text,
-- world!
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'

-- | Start a @TeX@ comment.
texComment :: T.Text
texComment :: Text
texComment = Text
"%"

-- | Start a @TeX@ comment plus a space.
texCommentSpace :: T.Text
texCommentSpace :: Text
texCommentSpace = Text
texComment forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | 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
toInternalConfig -> Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) Tokens
tokens =
  [Text] -> [Text]
dropEmpties forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ (Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens (Token
Dedent forall a. a -> [a] -> [a]
: Tokens
tokens) (Int
0, [])))
 where
  fromTokens :: Tokens -> (Int, [[T.Text]]) -> [[T.Text]]
  fromTokens :: Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens bs' :: Tokens
bs'@(Token
_ : Token
cur : Tokens
bs) (Int
curIndent, [[Text]]
rs) =
    Tokens -> (Int, [[Text]]) -> [[Text]]
fromTokens (Token
cur forall a. a -> [a] -> [a]
: Tokens
bs) (Int -> Tokens -> [[Text]] -> (Int, [[Text]])
translate Int
curIndent Tokens
bs' [[Text]]
rs)
  fromTokens [Token
_] (Int
_, [[Text]]
rs) = [[Text]]
rs
  fromTokens Tokens
_ (Int, [[Text]])
_ = forall a. Format -> a
errorNotEnoughTokens Format
TeX
  translate :: Int -> Tokens -> [[Text]] -> (Int, [[Text]])
translate Int
curIndent (Token
prev : Token
cur : Tokens
_) [[Text]]
rs =
    case Token
cur of
      Indent{Int
n :: Int
$sel:n:Indent :: Token -> Int
..} -> (Int
n,) forall a b. (a -> b) -> a -> b
$ [Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal Text
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
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 Text
_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 Text
_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 Text
_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)
  translate Int
_ Tokens
_ [[Text]]
_ = forall a. Format -> a
errorNotEnoughTokens Format
TeX

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

-- | Drop spaces at the start and the end of a 'T.Text'.
stripSpaces :: T.Text -> T.Text
stripSpaces :: Text -> Text
stripSpaces = Text -> Text
T.strip

-- | Prepend start of a @TeX@ comment (@'% '@) to a 'T.Text'.
prependTexComment :: T.Text -> T.Text
prependTexComment :: Text -> Text
prependTexComment Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise = Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Text
l

-- | Drop start of a @TeX@ comment from a 'T.Text'.
dropTexComment :: Show a => T.Text -> a -> T.Text
dropTexComment :: forall a. Show a => Text -> a -> Text
dropTexComment Text
l a
lineNumber
  | Text
l Text -> Text -> Bool
`startsWith` Text
texCommentSpace = Text -> Text -> Text
dropLen Text
texCommentSpace Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise =
      forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
        [Char]
"Lines in a 'Disabled' block must either be empty or start with '% '\n\n"
          forall a. Semigroup a => a -> a -> a
<> [Char]
"Note that each 'Disabled' block must have at least one line starting with '% ' and having nonempty text after '% ' "
          forall a. Semigroup a => a -> a -> a
<> ([Char]
"The line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show a
lineNumber forall a. Semigroup a => a -> a -> a
<> [Char]
" must either be empty or start with '% '")

-- | 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
toInternalConfig -> conf :: Config Internal
conf@Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkIntoTokens State -> [(Int, Text)] -> Tokens -> Tokens
toTokens Text
xs
  toTokens :: State -> [(Int, T.Text)] -> Tokens -> Tokens
  toTokens :: State -> [(Int, Text)] -> Tokens -> Tokens
toTokens State{Bool
inComment :: Bool
inDisabled :: Bool
inHaskellCode :: Bool
inText :: Bool
$sel:inComment:State :: State -> Bool
$sel:inDisabled:State :: State -> Bool
$sel:inHaskellCode:State :: State -> Bool
$sel:inText:State :: State -> Bool
..} ((Int
lineNumber, Text
l) : [(Int, Text)]
ls) result :: Tokens
result@(Token
r : Tokens
rs)
    | Bool
inDisabled =
        if
            | -- enable
              Text
l Text -> Text -> Bool
`startsWith` (Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal Text
_enable) ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
            | -- copy lines
              Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inDisabled :: Bool
$sel:inDisabled:State :: Bool
inDisabled} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = forall a. Show a => Text -> a -> Text
dropTexComment Text
l Int
lineNumber forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Disabled{}
    | Bool
inHaskellCode =
        if
            | -- end of a snippet
              Text -> Text
stripSpaces Text
l Text -> Text -> Bool
`startsWith` Mode Internal Text
_texHaskellCodeEnd ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls (Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
result)
            | Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inHaskellCode :: Bool
$sel:inHaskellCode:State :: Bool
inHaskellCode} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = Text
l forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected HaskellCode{}
    | Text -> Text
stripSpaces Text
l Text -> Text -> Bool
`startsWith` Mode Internal Text
_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 Text
_disable ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inDisabled:State :: Bool
inDisabled = Bool
True} [(Int, Text)]
ls ([Text] -> Token
Disabled [] forall a. a -> [a] -> [a]
: Tokens
result)
                | Bool
otherwise ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                      Config Internal -> Token -> Text -> Int -> Tokens
parseToken Config Internal
conf Token
r Text
l' Int
lineNumber forall a. Semigroup a => a -> a -> a
<> Tokens
rs
    | Bool
inText =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inText :: Bool
$sel:inText:State :: Bool
inText} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          case Token
r of
            Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs
            Token
_ -> Token -> Tokens
errorExpected Text{}
    | -- a blank line
      Text -> Bool
T.null Text
l =
        case Token
r of
          Comment{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
someLines} -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inComment :: Bool
$sel:inComment:State :: Bool
inComment} [(Int, Text)]
ls (Comment{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs)
          Token
_ -> State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
    | -- start of a text
      Bool
otherwise =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
result
   where
    errorExpected :: Token -> Tokens
errorExpected = forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res

-- | Convert 'Tokens' to @Literate Haskell@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
--
-- - These are the relations between document blocks and tokens when the default 'Config' values are used.
--
--     - @'% LIMA_INDENT N'@ (@N@ is an 'Int') ~ 'Indent'.
--     - @'% LIMA_DEDENT'@ ~ 'Dedent'.
--     - Lines between and including @'% LIMA_DISABLE'@ and @'% LIMA_ENABLE'@ ~ 'Disabled'.
--
--         - There must be at least one nonempty line between these tags.
--
--     - Consecutive lines, either empty or starting with @'% '@ ~ 'Comment'.
--
--         @
--         % Hello,
--         % world!
--
--         % Hello,
--         % user!
--         @
--
--         - At least one line must have nonempty text after @'% '@
--
--     - Consecutive lines starting with @'> '@ ~ 'HaskellCode'.
--
--         @
--         > a4 = 4
--         > a2 = 2
--         @
--
--     - Other lines ~ 'Text'.
--
-- === __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
-- >   a = const 3
-- >   b = a 4
-- <BLANKLINE>
-- % LIMA_DEDENT
-- <BLANKLINE>
-- > answer = b * 14
-- <BLANKLINE>
-- % Hello from comments,
-- <BLANKLINE>
-- % world!
-- <BLANKLINE>
-- Hello from text,
-- world!
-- <BLANKLINE>
-- And from
-- here!
lhsFromTokens :: Config User -> Tokens -> T.Text
lhsFromTokens :: Config User -> Tokens -> Text
lhsFromTokens Config User
config Tokens
tokens = (Config User -> Tokens -> [Text]) -> Config User -> Tokens -> Text
mkFromTokens Config User -> Tokens -> [Text]
lhsFromTokens' Config User
config Tokens
tokens

-- | Start a @Literate Haskell@ comment.
lhsComment :: T.Text
lhsComment :: Text
lhsComment = Text
"%"

-- | Start a @Literate Haskell@ comment plus a space.
lhsCommentSpace :: T.Text
lhsCommentSpace :: Text
lhsCommentSpace = Text
lhsComment forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | Start a @Literate Haskell@ line of @Haskell@ code.
lhsHsCode :: T.Text
lhsHsCode :: Text
lhsHsCode = Text
">"

-- | Start a @Literate Haskell@ line of @Haskell@ code plus a space.
lhsHsCodeSpace :: T.Text
lhsHsCodeSpace :: Text
lhsHsCodeSpace = Text
lhsHsCode forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | Prepend start of a @TeX@ comment (@'% '@) to a 'T.Text'.
prependLhsComment :: T.Text -> T.Text
prependLhsComment :: Text -> Text
prependLhsComment Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise = Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Text
l

-- | 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
toInternalConfig -> Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) 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 (Token
Dedent forall a. a -> [a] -> [a]
: Tokens
blocks) (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
Lhs
  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
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal Text
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
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
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal Text
_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
lhsCommentSpace forall a. Semigroup a => a -> a -> a
<> Mode Internal Text
_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 Text
_disable] forall a. a -> [a] -> [a]
: [] forall a. a -> [a] -> [a]
: [[Text]]
rs
      HaskellCode{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} ->
        (Int
curIndent,) forall a b. (a -> b) -> a -> b
$
          ((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]
: ( 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 (Text -> Text
lhsEscapeHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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)
  translate Int
_ Tokens
_ [[Text]]
_ = forall a. Format -> a
errorNotEnoughTokens Format
Lhs

-- | Drop start of a @TeX@ comment from a 'T.Text'.
dropLhsComment :: Show a => T.Text -> a -> T.Text
dropLhsComment :: forall a. Show a => Text -> a -> Text
dropLhsComment Text
l a
lineNumber
  | Text
l Text -> Text -> Bool
`startsWith` Text
lhsCommentSpace = Text -> Text -> Text
dropLen Text
lhsCommentSpace Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"The line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show a
lineNumber forall a. Semigroup a => a -> a -> a
<> [Char]
" must either be empty or start with '% '"

-- | 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
toInternalConfig -> conf :: Config Internal
conf@Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkIntoTokens 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 Text
_enable) ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
result
            | -- copy lines
              Bool
otherwise ->
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inDisabled :: Bool
$sel:inDisabled:State :: Bool
inDisabled} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                  case Token
r of
                    Disabled{[Text]
manyLines :: [Text]
$sel:manyLines:Indent :: Token -> [Text]
..} -> (Token
r{$sel:manyLines:Indent :: [Text]
manyLines = forall a. Show a => Text -> a -> Text
dropLhsComment Text
l Int
lineNumber forall a. a -> [a] -> [a]
: [Text]
manyLines} forall a. a -> [a] -> [a]
: Tokens
rs)
                    Token
_ -> Token -> Tokens
errorExpected Disabled{}
    | -- comment on a single line
      Text
l Text -> Text -> Bool
`startsWith` Text
lhsCommentSpace =
        let l' :: Text
l' = Text -> Text -> Text
dropLen Text
lhsCommentSpace Text
l
         in if
                | -- disable
                  Text
l' Text -> Text -> Bool
`startsWith` Mode Internal Text
_disable ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inDisabled:State :: Bool
inDisabled = Bool
True} [(Int, Text)]
ls ([Text] -> Token
Disabled [] forall a. a -> [a] -> [a]
: Tokens
result)
                | Bool
otherwise ->
                    State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
                      Config Internal -> Token -> Text -> Int -> Tokens
parseToken Config Internal
conf 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 => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res

-- | Convert 'Tokens' to @Markdown@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
--
-- - These are the relations between document blocks and tokens when the default 'Config' values are used.
--
--     - @'<!-- LIMA_INDENT N --\>'@ (@N@ is an 'Int') ~ 'Indent'
--     - @'<!-- LIMA_DEDENT --\>'@ ~ 'Dedent'.
--     - Multiline comment
--       starting with @'<!-- LIMA_DISABLE\\n'@
--       and ending with @'\\nLIMA_ENABLE --\>'@  ~ 'Disabled'.
--
--         @
--         <!-- LIMA_DISABLE
--         a4 = 4
--         a2 = 2
--         LIMA_ENABLE --\>
--         @
--
--     - Multiline comments starting with @'<!-- {text}'@ where @{text}@ is nonempty text ~ 'Comment'.
--
--         @
--         <!-- line 1
--         line 2
--         --\>
--         @
--
--         - Consecutive 'Comment's are merged into a single 'Comment'.
--
--     - Possibly indented block starting with @\'```haskell\'@ and ending with @'```'@ ~ 'HaskellCode'.
--
--         @
--           ```haskell
--             a4 = 2
--           ```
--         @
--
--     - Other lines ~ 'Text'.
--
--         @
--         Hello, world!
--         @
--
-- === __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>
-- Hello from text,
-- world!
-- <BLANKLINE>
-- And from
-- here!
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'

-- | Open a @Markdown@ comment.
mdCommentOpen :: T.Text
mdCommentOpen :: Text
mdCommentOpen = Text
"<!--"

-- | Close a @Markdown@ comment.
mdCommentClose :: T.Text
mdCommentClose :: Text
mdCommentClose = Text
"-->"

-- | Open a @Markdown@ comment plus a space.
mdCommentOpenSpace :: T.Text
mdCommentOpenSpace :: Text
mdCommentOpenSpace = Text
mdCommentOpen forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | A space plus close a @Markdown@ comment.
mdCommentCloseSpace :: T.Text
mdCommentCloseSpace :: Text
mdCommentCloseSpace = Text
" " forall a. Semigroup a => a -> a -> a
<> Text
mdCommentClose

-- | Strip comment markers from a 'T.Text'.
stripMdComment :: T.Text -> T.Text
stripMdComment :: Text -> Text
stripMdComment = Text -> Text -> Text -> Text
stripEnds Text
mdCommentOpenSpace Text
mdCommentCloseSpace

-- | 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
toInternalConfig -> Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) 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 Text
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
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 Text
_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 Text
_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 Text
_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 Text
_mdHaskellCodeEnd] forall a. Semigroup a => a -> a -> a
<> [Text]
manyLines forall a. Semigroup a => a -> a -> a
<> [Mode Internal Text
_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{$sel:someLines:Indent :: Token -> NonEmpty Text
someLines = Text
t :| [Text]
ts} ->
        let ts' :: [Text]
ts' = Text
t forall a. a -> [a] -> [a]
: [Text]
ts
         in 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. [a] -> [a]
init [Text]
ts' forall a. Semigroup a => a -> a -> a
<> [Text
mdCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> a
last [Text]
ts'] forall a. a -> [a] -> [a]
: [[Text]]
res

-- | Show the name of a constructor.
constructorName :: Data a => a -> String
constructorName :: forall a. Data a => a -> [Char]
constructorName a
x = Constr -> [Char]
showConstr (forall a. Data a => a -> Constr
toConstr a
x)

-- | Remove empty lines from the beginning and the end of a list.
stripEmpties :: [T.Text] -> [T.Text]
stripEmpties :: [Text] -> [Text]
stripEmpties = forall a. Eq a => a -> [a] -> [a]
stripList Text
T.empty

dropEmpties :: [T.Text] -> [T.Text]
dropEmpties :: [Text] -> [Text]
dropEmpties = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Text
T.empty)

-- | Check if a line without leading spaces is surrounded by the given 'T.Text's.
isEnclosedWith :: T.Text -> T.Text -> T.Text -> Bool
isEnclosedWith :: Text -> Text -> Text -> Bool
isEnclosedWith Text
start Text
end (Text -> Text
stripSpaces -> Text
x) = Text
x Text -> Text -> Bool
`startsWith` Text
start Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
`endsWith` Text
end

-- | Check if a line is a @Markdown@ comment.
isMdComment :: T.Text -> Bool
isMdComment :: Text -> Bool
isMdComment = Text -> Text -> Text -> Bool
isEnclosedWith Text
mdCommentOpenSpace Text
mdCommentCloseSpace

-- | Count leading spaces in a 'T.Text'.
countSpaces :: T.Text -> Int
countSpaces :: Text -> Int
countSpaces Text
x = Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
x

-- | Strip empty lines an 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!" :| []},
--   Text {someLines = "world!" :| ["Hello from text,"]},
--   Text {someLines = "here!" :| ["And from"]}
-- ]
--
-- >>> 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!" :| []},
--   Text {someLines = "world!" :| ["Hello from text,"]},
--   Text {someLines = "here!" :| ["And from"]}
-- ]
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

-- | 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
toInternalConfig -> conf :: Config Internal
conf@Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) Text
xs = Tokens
tokens
 where
  tokens :: Tokens
tokens = (State -> [(Int, Text)] -> Tokens -> Tokens) -> Text -> Tokens
mkIntoTokens 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 Text
_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 Text
_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 -> Token -> Text -> Int -> Tokens
parseToken Config Internal
conf 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 Text
_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 => [Char] -> 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 Text
_mdHaskellCodeStart =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inHaskellCode:State :: Bool
inHaskellCode = Bool
True} [(Int, Text)]
ls ([Text] -> Token
HaskellCode [] forall a. a -> [a] -> [a]
: Tokens
res)
    -- Again matters if in a text
    | Bool
inText =
        State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{Bool
inText :: Bool
$sel:inText:State :: Bool
inText} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$
          case Token
r of
            Text{NonEmpty Text
someLines :: NonEmpty Text
$sel:someLines:Indent :: Token -> NonEmpty Text
..} -> Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
someLines} forall a. a -> [a] -> [a]
: Tokens
rs
            Token
_ -> Token -> Tokens
errorExpected Text{}
    | Bool
otherwise =
        if
            | Text -> Bool
T.null Text
l ->
                -- skip
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def [(Int, Text)]
ls Tokens
res
            | Bool
otherwise ->
                -- start a text
                State -> [(Int, Text)] -> Tokens -> Tokens
toTokens forall a. Default a => a
def{$sel:inText:State :: Bool
inText = Bool
True} [(Int, Text)]
ls forall a b. (a -> b) -> a -> b
$ Text{$sel:someLines:Indent :: NonEmpty Text
someLines = Text
l forall a. a -> [a] -> NonEmpty a
:| []} forall a. a -> [a] -> [a]
: Tokens
res
   where
    errorExpected :: Token -> Tokens
errorExpected = forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2 a3 a4.
(Data a1, Show a2, Show a3) =>
a2 -> a3 -> a1 -> a4
errorExpectedToken Int
lineNumber Token
r
  toTokens State
_ [(Int, Text)]
_ Tokens
res = Tokens
res

-- | Convert 'Tokens' to @Haskell@ code.
--
-- __Rules__
--
-- - Certain [assumptions]("Converter#assumptions") must hold for inputs.
--
-- - These are the relations between document blocks and tokens when the default 'Config' values are used.
--
--     - @'{- LIMA_INDENT N -}'@ (@N@ is an 'Int') ~ 'Indent'.
--     - @'{- LIMA_DEDENT -}'@ ~ 'Dedent'.
--     - Lines between and including @'{- LIMA_DISABLE -}'@ and @'{- LIMA_ENABLE -}'@ ~ 'Disabled'.
--
--     - Multiline comment starting with @'{-\\n'@ ~ 'Text'.
--
--         @
--         {-
--         line 1
--         -}
--         @
--
--         - Consecutive 'Text's are merged into a single 'Text'.
--         - There must be at list one nonempty line inside this comment.
--
--     - Multiline comment starting with @'{- '@ where @<text>@ is nonempty text ~ 'Comment'.
--
--         @
--         {- line 1
--         line 2
--         -}
--         @
--
--         - Consecutive 'Comment's are merged into a single 'Comment'.
--
--     - Other lines ~ 'HaskellCode'.
--
--         @
--         a = 42
--         @
--
-- === __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>
-- {-
-- Hello from text,
-- world!
-- <BLANKLINE>
-- And from
-- here!
-- -}
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'

-- | Open a @Haskell@ multi-line comment.
hsCommentOpen :: T.Text
hsCommentOpen :: Text
hsCommentOpen = Text
"{-"

-- | Open a @Haskell@ multi-line comment plus a space.
hsCommentOpenSpace :: T.Text
hsCommentOpenSpace :: Text
hsCommentOpenSpace = Text
hsCommentOpen forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | Close a @Haskell@ multi-line comment.
hsCommentClose :: T.Text
hsCommentClose :: Text
hsCommentClose = Text
"-}"

-- | A space plus close a @Haskell@ multi-line comment.
hsCommentCloseSpace :: T.Text
hsCommentCloseSpace :: Text
hsCommentCloseSpace = Text
" " forall a. Semigroup a => a -> a -> a
<> Text
hsCommentClose

-- | 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
toInternalConfig -> Config{Mode Internal Text
_texHaskellCodeEnd :: Mode Internal Text
_texHaskellCodeStart :: Mode Internal Text
_mdHaskellCodeEnd :: Mode Internal Text
_mdHaskellCodeStart :: Mode Internal Text
_dedent :: Mode Internal Text
_indent :: Mode Internal Text
_enable :: Mode Internal Text
_disable :: Mode Internal Text
$sel:_texHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_texHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeEnd:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_mdHaskellCodeStart:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_dedent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_indent:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_enable:Config :: forall (a :: Mode'). Config a -> Mode a Text
$sel:_disable:Config :: forall (a :: Mode'). Config a -> Mode a Text
..}) 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 Text
_indent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
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 Text
_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 Text
_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 Text
_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{$sel:someLines:Indent :: Token -> NonEmpty Text
someLines = Text
t :| [Text]
ts} ->
          let ts' :: [Text]
ts' = Text
t forall a. a -> [a] -> [a]
: [Text]
ts
           in [Text
hsCommentClose] forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [a]
init [Text]
ts' forall a. Semigroup a => a -> a -> a
<> [Text
hsCommentOpenSpace forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> a
last [Text]
ts'] forall a. a -> [a] -> [a]
: [[Text]]
res

-- | Drop leading spaces and drop at each end of a 'T.Text' the number of characters as in the supplied prefix and suffix.
stripHsComment :: T.Text -> T.Text
stripHsComment :: Text -> Text
stripHsComment = Text -> Text -> Text -> Text
stripEnds Text
hsCommentOpenSpace Text
hsCommentCloseSpace

-- | Check if a line without leading zeros is a multi-line @Haskell@ comment
isHsComment :: T.Text -> Bool
isHsComment :: Text -> Bool
isHsComment = Text -> Text -> Text -> Bool
isEnclosedWith Text
hsCommentOpenSpace Text
hsCommentCloseSpace

-- | Show error with line number for a token.
-- errorEmptyCommentAt :: Int -> String
errorEmptyCommentAt :: Show a1 => a1 -> a2
errorEmptyCommentAt :: forall a1 a2. Show a1 => a1 -> a2
errorEmptyCommentAt a1
lineNumber =
  forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
    ([Char]
"Expected a 'Comment' at line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show a1
lineNumber forall a. Semigroup a => a -> a -> a
<> [Char]
".\n\n")
      forall a. Semigroup a => a -> a -> a
<> [Char]
"However, there are no characters after '{- '.\n\n"
      forall a. Semigroup a => a -> a -> a
<> [Char]
"Please, write there something after '{- '."

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

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

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

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