    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE FlexibleInstances  #-}
    {-# LANGUAGE NoImplicitPrelude  #-}
    {-# LANGUAGE OverloadedStrings  #-}
    module Text.DocLayout.HasChars (HasChars(..)) where
    import Prelude
    import Data.String
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import Data.Text (Text)
    import qualified Data.Text.Lazy.Builder as B
    import Data.List (foldl', uncons)
    import Data.Maybe (fromMaybe)
    import Text.DocLayout.Attributed
    import Data.Sequence (Seq(..), (|>))
    import qualified Data.Sequence as S

    -- | Class abstracting over various string types that
    -- can fold over characters.  Minimal definition is 'foldrChar'
    -- and 'foldlChar', but defining the other methods can give better
    -- performance.
    class (IsString a, Semigroup a, Monoid a, Show a) => HasChars a where
      foldrChar     :: (Char -> b -> b) -> b -> a -> b
      foldlChar     :: (b -> Char -> b) -> b -> a -> b
      replicateChar :: Int -> Char -> a
      replicateChar Int
    n Char
    c = String -> a
    forall a. IsString a => String -> a
    fromString (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    c)
      isNull        :: a -> Bool
      isNull = (Char -> Bool -> Bool) -> Bool -> a -> Bool
    forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
    forall b. (Char -> b -> b) -> b -> a -> b
    foldrChar (\Char
    _ Bool
    _ -> Bool
    False) Bool
    True
      splitLines    :: a -> [a]
      splitLines a
    s = (String -> a
    forall a. IsString a => String -> a
    fromString String
    firstline a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    otherlines)
       where
        (String
    firstline, [a]
    otherlines) = (Char -> (String, [a]) -> (String, [a]))
    -> (String, [a]) -> a -> (String, [a])
    forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
    forall b. (Char -> b -> b) -> b -> a -> b
    foldrChar Char -> (String, [a]) -> (String, [a])
    forall {a}. IsString a => Char -> (String, [a]) -> (String, [a])
    go ([],[]) a
    s
        go :: Char -> (String, [a]) -> (String, [a])
    go Char
    '\n' (String
    cur,[a]
    lns) = ([], String -> a
    forall a. IsString a => String -> a
    fromString String
    cur a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    lns)
        go Char
    c    (String
    cur,[a]
    lns) = (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cur, [a]
    lns)
      build         :: a -> B.Builder
      build = (Char -> Builder -> Builder) -> Builder -> a -> Builder
    forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
    forall b. (Char -> b -> b) -> b -> a -> b
    foldrChar (Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    mappend (Builder -> Builder -> Builder)
    -> (Char -> Builder) -> Char -> Builder -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Builder
    B.singleton) (String -> Builder
    B.fromString String
    "")

    instance HasChars Text where
      foldrChar :: forall b. (Char -> b -> b) -> b -> Text -> b
    foldrChar         = (Char -> b -> b) -> b -> Text -> b
    forall b. (Char -> b -> b) -> b -> Text -> b
    T.foldr
      foldlChar :: forall b. (b -> Char -> b) -> b -> Text -> b
    foldlChar         = (b -> Char -> b) -> b -> Text -> b
    forall b. (b -> Char -> b) -> b -> Text -> b
    T.foldl'
      splitLines :: Text -> [Text]
    splitLines        = HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "\n"
      replicateChar :: Int -> Char -> Text
    replicateChar Int
    n Char
    c = Int -> Text -> Text
    T.replicate Int
    n (Char -> Text
    T.singleton Char
    c)
      isNull :: Text -> Bool
    isNull            = Text -> Bool
    T.null
      build :: Text -> Builder
    build             = Text -> Builder
    B.fromText

    instance HasChars String where
      foldrChar :: forall b. (Char -> b -> b) -> b -> String -> b
    foldrChar     = (Char -> b -> b) -> b -> String -> b
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
      foldlChar :: forall b. (b -> Char -> b) -> b -> String -> b
    foldlChar     = (b -> Char -> b) -> b -> String -> b
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl'
      splitLines :: String -> [String]
    splitLines    = String -> [String]
    lines (String -> [String]) -> (String -> String) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\n")
      replicateChar :: Int -> Char -> String
    replicateChar = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate
      isNull :: String -> Bool
    isNull        = String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null
      build :: String -> Builder
    build         = String -> Builder
    B.fromString

    instance HasChars TL.Text where
      foldrChar :: forall b. (Char -> b -> b) -> b -> Text -> b
    foldrChar         = (Char -> b -> b) -> b -> Text -> b
    forall b. (Char -> b -> b) -> b -> Text -> b
    TL.foldr
      foldlChar :: forall b. (b -> Char -> b) -> b -> Text -> b
    foldlChar         = (b -> Char -> b) -> b -> Text -> b
    forall b. (b -> Char -> b) -> b -> Text -> b
    TL.foldl'
      splitLines :: Text -> [Text]
    splitLines        = HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    TL.splitOn Text
    "\n"
      replicateChar :: Int -> Char -> Text
    replicateChar Int
    n Char
    c = Int64 -> Text -> Text
    TL.replicate (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n) (Char -> Text
    TL.singleton Char
    c)
      isNull :: Text -> Bool
    isNull            = Text -> Bool
    TL.null
      build :: Text -> Builder
    build             = Text -> Builder
    B.fromLazyText

    instance HasChars a => HasChars (Attr a) where
      foldrChar :: forall b. (Char -> b -> b) -> b -> Attr a -> b
    foldrChar Char -> b -> b
    f b
    a (Attr Link
    _ Font
    _ a
    x) = (Char -> b -> b) -> b -> a -> b
    forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
    forall b. (Char -> b -> b) -> b -> a -> b
    foldrChar Char -> b -> b
    f b
    a a
    x
      foldlChar :: forall b. (b -> Char -> b) -> b -> Attr a -> b
    foldlChar b -> Char -> b
    f b
    a (Attr Link
    _ Font
    _ a
    x) = (b -> Char -> b) -> b -> a -> b
    forall a b. HasChars a => (b -> Char -> b) -> b -> a -> b
    forall b. (b -> Char -> b) -> b -> a -> b
    foldlChar b -> Char -> b
    f b
    a a
    x
      splitLines :: Attr a -> [Attr a]
    splitLines (Attr Link
    l Font
    f a
    x) = Link -> Font -> a -> Attr a
    forall a. Link -> Font -> a -> Attr a
    Attr Link
    l Font
    f (a -> Attr a) -> [a] -> [Attr a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> [a]
    forall a. HasChars a => a -> [a]
    splitLines a
    x
      build :: Attr a -> Builder
    build (Attr Link
    _ Font
    _ a
    x) = a -> Builder
    forall a. HasChars a => a -> Builder
    build a
    x

    instance (HasChars a) => HasChars (Attributed a) where
      foldrChar :: forall b. (Char -> b -> b) -> b -> Attributed a -> b
    foldrChar Char -> b -> b
    _ b
    acc (Attributed Seq (Attr a)
    S.Empty) = b
    acc
      foldrChar Char -> b -> b
    f b
    acc (Attributed (Seq (Attr a)
    xs :|> (Attr Link
    _ Font
    _ a
    x))) =
        let l :: b
    l = (Char -> b -> b) -> b -> a -> b
    forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
    forall b. (Char -> b -> b) -> b -> a -> b
    foldrChar Char -> b -> b
    f b
    acc a
    x
            innerFold :: a -> b -> b
    innerFold a
    e b
    a = (Char -> b -> b) -> b -> a -> b
    forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
    forall b. (Char -> b -> b) -> b -> a -> b
    foldrChar Char -> b -> b
    f b
    a a
    e
         in (Attr a -> b -> b) -> b -> Seq (Attr a) -> b
    forall a b. (a -> b -> b) -> b -> Seq a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Attr a -> b -> b
    forall {a}. HasChars a => a -> b -> b
    innerFold b
    l Seq (Attr a)
    xs
      foldlChar :: forall b. (b -> Char -> b) -> b -> Attributed a -> b
    foldlChar b -> Char -> b
    _ b
    acc (Attributed Seq (Attr a)
    S.Empty) = b
    acc
      foldlChar b -> Char -> b
    f b
    acc (Attributed ((Attr Link
    _ Font
    _ a
    x) :<| Seq (Attr a)
    xs)) =
        let l :: b
    l = (b -> Char -> b) -> b -> a -> b
    forall a b. HasChars a => (b -> Char -> b) -> b -> a -> b
    forall b. (b -> Char -> b) -> b -> a -> b
    foldlChar b -> Char -> b
    f b
    acc a
    x
            innerFold :: a -> b -> b
    innerFold a
    e b
    a = (b -> Char -> b) -> b -> a -> b
    forall a b. HasChars a => (b -> Char -> b) -> b -> a -> b
    forall b. (b -> Char -> b) -> b -> a -> b
    foldlChar b -> Char -> b
    f b
    a a
    e
         in (Attr a -> b -> b) -> b -> Seq (Attr a) -> b
    forall a b. (a -> b -> b) -> b -> Seq a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Attr a -> b -> b
    forall {a}. HasChars a => a -> b -> b
    innerFold b
    l Seq (Attr a)
    xs
      splitLines :: Attributed a -> [Attributed a]
    splitLines (Attributed Seq (Attr a)
    s) = (Seq (Attr a) -> Attributed a) -> [Seq (Attr a)] -> [Attributed a]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Seq (Attr a) -> Attributed a
    forall a. Seq (Attr a) -> Attributed a
    Attributed ([Seq (Attr a)] -> [Attributed a])
    -> [Seq (Attr a)] -> [Attributed a]
    forall a b. (a -> b) -> a -> b
    $ [Seq (Attr a)] -> [Seq (Attr a)]
    forall a. [a] -> [a]
    reverse ([Seq (Attr a)] -> [Seq (Attr a)])
    -> [Seq (Attr a)] -> [Seq (Attr a)]
    forall a b. (a -> b) -> a -> b
    $ ([Seq (Attr a)], Seq (Attr a)) -> Seq (Attr a) -> [Seq (Attr a)]
    forall {a}. HasChars a => ([Seq a], Seq a) -> Seq a -> [Seq a]
    go ([], Seq (Attr a)
    forall a. Seq a
    S.empty) Seq (Attr a)
    s
        where
          go :: ([Seq a], Seq a) -> Seq a -> [Seq a]
    go ([Seq a]
    lns, Seq a
    cur) Seq a
    S.Empty = Seq a
    cur Seq a -> [Seq a] -> [Seq a]
    forall a. a -> [a] -> [a]
    : [Seq a]
    lns
          go ([Seq a]
    lns, Seq a
    cur) (a
    x :<| Seq a
    xs) =
            case a -> [a]
    forall a. HasChars a => a -> [a]
    splitLines a
    x of
              []      -> ([Seq a], Seq a) -> Seq a -> [Seq a]
    go (Seq a
    cur Seq a -> [Seq a] -> [Seq a]
    forall a. a -> [a] -> [a]
    : [Seq a]
    lns, Seq a
    forall a. Seq a
    S.empty) Seq a
    xs
              [a
    k1]    -> ([Seq a], Seq a) -> Seq a -> [Seq a]
    go ([Seq a]
    lns, Seq a
    cur Seq a -> a -> Seq a
    forall a. Seq a -> a -> Seq a
    |> a
    k1) Seq a
    xs
              a
    k1 : [a]
    ks ->
                let (Seq a
    end, [Seq a]
    most) = (Seq a, [Seq a]) -> Maybe (Seq a, [Seq a]) -> (Seq a, [Seq a])
    forall a. a -> Maybe a -> a
    fromMaybe (Seq a
    forall a. Seq a
    S.empty, []) (Maybe (Seq a, [Seq a]) -> (Seq a, [Seq a]))
    -> Maybe (Seq a, [Seq a]) -> (Seq a, [Seq a])
    forall a b. (a -> b) -> a -> b
    $ [Seq a] -> Maybe (Seq a, [Seq a])
    forall a. [a] -> Maybe (a, [a])
    uncons ([Seq a] -> Maybe (Seq a, [Seq a]))
    -> [Seq a] -> Maybe (Seq a, [Seq a])
    forall a b. (a -> b) -> a -> b
    $ [Seq a] -> [Seq a]
    forall a. [a] -> [a]
    reverse ([Seq a] -> [Seq a]) -> [Seq a] -> [Seq a]
    forall a b. (a -> b) -> a -> b
    $ a -> Seq a
    forall a. a -> Seq a
    S.singleton (a -> Seq a) -> [a] -> [Seq a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [a]
    ks
                 in ([Seq a], Seq a) -> Seq a -> [Seq a]
    go ([Seq a]
    most [Seq a] -> [Seq a] -> [Seq a]
    forall a. [a] -> [a] -> [a]
    ++ (Seq a
    cur Seq a -> a -> Seq a
    forall a. Seq a -> a -> Seq a
    |> a
    k1) Seq a -> [Seq a] -> [Seq a]
    forall a. a -> [a] -> [a]
    : [Seq a]
    lns, Seq a
    end) Seq a
    xs
      build :: Attributed a -> Builder
    build = (a -> Builder) -> Attributed a -> Builder
    forall m a. Monoid m => (a -> m) -> Attributed a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap a -> Builder
    forall a. HasChars a => a -> Builder
    build