    -- | This module provides an API for "marking up" text with arbitrary
    -- values. A piece of markup can then be converted to a list of pairs
    -- representing the sequences of characters assigned the same markup
    -- value.
    --
    -- This interface is experimental. Don't use this for your full-file
    -- syntax highlighter just yet!
    module Data.Text.Markup
      ( Markup
      , markupToList
      , markupSet
      , fromList
      , fromText
      , toText
      , isEmpty
      , (@@)
      )
    where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    import Data.Monoid
    #endif

    import qualified Data.Semigroup as Sem
    import Data.String (IsString(..))
    import qualified Data.Text as T

    -- | Markup with metadata type 'a' assigned to each character.
    data Markup a = Markup [(Char, a)]
                  deriving Int -> Markup a -> ShowS
    [Markup a] -> ShowS
    Markup a -> String
    (Int -> Markup a -> ShowS)
    -> (Markup a -> String) -> ([Markup a] -> ShowS) -> Show (Markup a)
    forall a. Show a => Int -> Markup a -> ShowS
    forall a. Show a => [Markup a] -> ShowS
    forall a. Show a => Markup a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Markup a] -> ShowS
    $cshowList :: forall a. Show a => [Markup a] -> ShowS
    show :: Markup a -> String
    $cshow :: forall a. Show a => Markup a -> String
    showsPrec :: Int -> Markup a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> Markup a -> ShowS
    Show

    instance Sem.Semigroup (Markup a) where
        (Markup t1 :: [(Char, a)]
    t1) <> :: Markup a -> Markup a -> Markup a
    <> (Markup t2 :: [(Char, a)]
    t2) = [(Char, a)] -> Markup a
    forall a. [(Char, a)] -> Markup a
    Markup ([(Char, a)]
    t1 [(Char, a)] -> [(Char, a)] -> [(Char, a)]
    forall a. Monoid a => a -> a -> a
    `mappend` [(Char, a)]
    t2)

    instance Monoid (Markup a) where
        mempty :: Markup a
    mempty = [(Char, a)] -> Markup a
    forall a. [(Char, a)] -> Markup a
    Markup [(Char, a)]
    forall a. Monoid a => a
    mempty
        mappend :: Markup a -> Markup a -> Markup a
    mappend = Markup a -> Markup a -> Markup a
    forall a. Semigroup a => a -> a -> a
    (Sem.<>)

    instance (Monoid a) => IsString (Markup a) where
        fromString :: String -> Markup a
    fromString = Text -> Markup a
    forall a. Monoid a => Text -> Markup a
    fromText (Text -> Markup a) -> (String -> Text) -> String -> Markup a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

    -- | Build a piece of markup; assign the specified metadata to every
    -- character in the specified text.
    (@@) :: T.Text -> a -> Markup a
    t :: Text
    t @@ :: Text -> a -> Markup a
    @@ val :: a
    val = [(Char, a)] -> Markup a
    forall a. [(Char, a)] -> Markup a
    Markup [(Char
    c, a
    val) | Char
    c <- Text -> String
    T.unpack Text
    t]

    -- | Build markup from text with the default metadata.
    fromText :: (Monoid a) => T.Text -> Markup a
    fromText :: Text -> Markup a
    fromText = (Text -> a -> Markup a
    forall a. Text -> a -> Markup a
    @@ a
    forall a. Monoid a => a
    mempty)

    -- | Extract the text from markup, discarding the markup metadata.
    toText :: (Eq a) => Markup a -> T.Text
    toText :: Markup a -> Text
    toText = [Text] -> Text
    T.concat ([Text] -> Text) -> (Markup a -> [Text]) -> Markup a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, a) -> Text
    forall a b. (a, b) -> a
    fst ((Text, a) -> Text) -> [(Text, a)] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) ([(Text, a)] -> [Text])
    -> (Markup a -> [(Text, a)]) -> Markup a -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[(Text, a)]] -> [(Text, a)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(Text, a)]] -> [(Text, a)])
    -> (Markup a -> [[(Text, a)]]) -> Markup a -> [(Text, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup a -> [[(Text, a)]]
    forall a. Eq a => Markup a -> [[(Text, a)]]
    markupToList

    -- | Test whether the markup is empty.
    isEmpty :: Markup a -> Bool
    isEmpty :: Markup a -> Bool
    isEmpty (Markup ls :: [(Char, a)]
    ls) = [(Char, a)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Char, a)]
    ls

    -- | Set the metadata for a range of character positions in a piece of
    -- markup. This is useful for, e.g., syntax highlighting.
    markupSet :: (Eq a) => (Int, Int) -> a -> Markup a -> Markup a
    markupSet :: (Int, Int) -> a -> Markup a -> Markup a
    markupSet (start :: Int
    start, len :: Int
    len) val :: a
    val m :: Markup a
    m@(Markup l :: [(Char, a)]
    l) = if Int
    start Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 Bool -> Bool -> Bool
    || Int
    start Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > [(Char, a)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Char, a)]
    l
                                              then Markup a
    m
                                              else Markup a
    newM
        where
            newM :: Markup a
    newM = [(Char, a)] -> Markup a
    forall a. [(Char, a)] -> Markup a
    Markup ([(Char, a)] -> Markup a) -> [(Char, a)] -> Markup a
    forall a b. (a -> b) -> a -> b
    $ [(Char, a)]
    theHead [(Char, a)] -> [(Char, a)] -> [(Char, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(Char, a)]
    theNewEntries [(Char, a)] -> [(Char, a)] -> [(Char, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(Char, a)]
    theTail
            (theHead :: [(Char, a)]
    theHead, theLongTail :: [(Char, a)]
    theLongTail) = Int -> [(Char, a)] -> ([(Char, a)], [(Char, a)])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    start [(Char, a)]
    l
            (theOldEntries :: [(Char, a)]
    theOldEntries, theTail :: [(Char, a)]
    theTail) = Int -> [(Char, a)] -> ([(Char, a)], [(Char, a)])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    len [(Char, a)]
    theLongTail
            theNewEntries :: [(Char, a)]
    theNewEntries = String -> [a] -> [(Char, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((Char, a) -> Char
    forall a b. (a, b) -> a
    fst ((Char, a) -> Char) -> [(Char, a)] -> String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Char, a)]
    theOldEntries) (a -> [a]
    forall a. a -> [a]
    repeat a
    val)

    -- | Convert markup to a list of lines. Each line is represented by a
    -- list of pairs in which each pair contains the longest subsequence of
    -- characters having the same metadata.
    markupToList :: (Eq a) => Markup a -> [[(T.Text, a)]]
    markupToList :: Markup a -> [[(Text, a)]]
    markupToList (Markup thePairs :: [(Char, a)]
    thePairs) = [(Char, a)] -> [(Text, a)]
    forall b. Eq b => [(Char, b)] -> [(Text, b)]
    toList ([(Char, a)] -> [(Text, a)]) -> [[(Char, a)]] -> [[(Text, a)]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[(Char, a)]] -> [(Char, a)] -> [(Char, a)] -> [[(Char, a)]]
    forall b.
    [[(Char, b)]] -> [(Char, b)] -> [(Char, b)] -> [[(Char, b)]]
    toLines [] [] [(Char, a)]
    thePairs
        where
            toLines :: [[(Char, b)]] -> [(Char, b)] -> [(Char, b)] -> [[(Char, b)]]
    toLines ls :: [[(Char, b)]]
    ls cur :: [(Char, b)]
    cur [] = [[(Char, b)]]
    ls [[(Char, b)]] -> [[(Char, b)]] -> [[(Char, b)]]
    forall a. [a] -> [a] -> [a]
    ++ [[(Char, b)]
    cur]
            toLines ls :: [[(Char, b)]]
    ls cur :: [(Char, b)]
    cur ((ch :: Char
    ch, val :: b
    val):rest :: [(Char, b)]
    rest)
                | Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\n' = [[(Char, b)]] -> [(Char, b)] -> [(Char, b)] -> [[(Char, b)]]
    toLines ([[(Char, b)]]
    ls [[(Char, b)]] -> [[(Char, b)]] -> [[(Char, b)]]
    forall a. [a] -> [a] -> [a]
    ++ [[(Char, b)]
    cur]) [] [(Char, b)]
    rest
                | Bool
    otherwise = [[(Char, b)]] -> [(Char, b)] -> [(Char, b)] -> [[(Char, b)]]
    toLines [[(Char, b)]]
    ls ([(Char, b)]
    cur [(Char, b)] -> [(Char, b)] -> [(Char, b)]
    forall a. [a] -> [a] -> [a]
    ++ [(Char
    ch, b
    val)]) [(Char, b)]
    rest

            toList :: [(Char, b)] -> [(Text, b)]
    toList [] = []
            toList ((ch :: Char
    ch, val :: b
    val):rest :: [(Char, b)]
    rest) = (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Char
    ch Char -> ShowS
    forall a. a -> [a] -> [a]
    : ((Char, b) -> Char
    forall a b. (a, b) -> a
    fst ((Char, b) -> Char) -> [(Char, b)] -> String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Char, b)]
    matching), b
    val) (Text, b) -> [(Text, b)] -> [(Text, b)]
    forall a. a -> [a] -> [a]
    : [(Char, b)] -> [(Text, b)]
    toList [(Char, b)]
    remaining
                where
                    (matching :: [(Char, b)]
    matching, remaining :: [(Char, b)]
    remaining) = ((Char, b) -> Bool) -> [(Char, b)] -> ([(Char, b)], [(Char, b)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (\(_, v :: b
    v) -> b
    v b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    /= b
    val) [(Char, b)]
    rest

    -- | Convert a list of text and metadata pairs into markup.
    fromList :: [(T.Text, a)] -> Markup a
    fromList :: [(Text, a)] -> Markup a
    fromList pairs :: [(Text, a)]
    pairs = [(Char, a)] -> Markup a
    forall a. [(Char, a)] -> Markup a
    Markup ([(Char, a)] -> Markup a) -> [(Char, a)] -> Markup a
    forall a b. (a -> b) -> a -> b
    $ ((Text, a) -> [(Char, a)]) -> [(Text, a)] -> [(Char, a)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\(t :: Text
    t, val :: a
    val) -> [(Char
    c, a
    val) | Char
    c <- Text -> String
    T.unpack Text
    t]) [(Text, a)]
    pairs