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