module Data.Text.ParagraphLayout.Internal.Run (Run (..), spanToRuns)
where

import Data.List (mapAccumL)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Foreign (dropWord8, lengthWord8, takeWord8)
import Data.Text.Glyphize (Direction (..))

import Data.Text.ParagraphLayout.Internal.BiDiLevels
import Data.Text.ParagraphLayout.Internal.ProtoRun (ProtoRun (ProtoRun))
import qualified Data.Text.ParagraphLayout.Internal.ProtoRun as PR
import Data.Text.ParagraphLayout.Internal.ResolvedSpan
import Data.Text.ParagraphLayout.Internal.Script
import Data.Text.ParagraphLayout.Internal.TextContainer
import Data.Text.ParagraphLayout.Internal.Zipper

-- | Each span can be broken into one or more runs by Balkón.
--
-- Each run could have a different script, language, or direction.
data Run = Run
    { runOffsetInSpan :: Int
    , runText :: Text
    , runLevel :: Level
    , runDirection :: Direction
    , runScript :: Maybe ScriptCode
    , runHardBreak :: Bool
    -- ^ Marks run that ends with a forced line break.
    -- Those should prevent creation of invisible line boxes
    -- according to <https://www.w3.org/TR/css-inline-3/#invisible-line-boxes>.
    }
    deriving (Eq, Show)

instance TextContainer Run where
    getText = runText

instance SeparableTextContainer Run where
    splitTextAt8 n r =
        ( r { runText = t1 }
        , r { runText = t2, runOffsetInSpan = runOffsetInSpan r + l1 }
        )
        where
            l1 = lengthWord8 t1
            t1 = takeWord8 (fromIntegral n) t
            t2 = dropWord8 (fromIntegral n) t
            t = getText r
    dropWhileStart p r = r { runText = t', runOffsetInSpan = o' }
        where
            t = runText r
            t' = Text.dropWhile p t
            l = lengthWord8 t
            l' = lengthWord8 t'
            o = runOffsetInSpan r
            o' = o + l - l'
    dropWhileEnd p r = r { runText = Text.dropWhileEnd p (runText r) }

-- | Represents a zipper that can advance by at least one character.
data ZipperChoice = ZipperChoice
    { nextChar :: Char
    , continuingRun :: Zipper
    -- ^ The zipper will advance over the next character,
    -- merging it with all preceding characters.
    , startingNewRun :: Zipper
    -- ^ The zipper will forget all preceding characters and then advance over
    -- the next character, making it the first character in a new run of text.
    }

considerNext :: Zipper -> Maybe ZipperChoice
considerNext z = case next z of
    Nothing -> Nothing
    Just c -> Just ZipperChoice
        { nextChar = c
        , continuingRun = step z
        , startingNewRun = step $ start $ following z
        }

data Merged a = Incompatible | Merged a

spanToRuns :: ResolvedSpan d -> [Run]
spanToRuns s
    | Text.null (spanText s) = [emptyRun]
    | otherwise = spanToRuns' s
    where
        emptyRun = Run
            { runOffsetInSpan = 0
            , runText = Text.empty
            , runLevel = defaultLevel
            , runDirection = levelDirectionH defaultLevel
            , runScript = Nothing
            , runHardBreak = False
            }
        defaultLevel = baseLevel $ spanBiDiLevels s

spanToRuns' :: ResolvedSpan d -> [Run]
spanToRuns' s = snd $ mapAccumL run 0 $ protoRuns zipper levels
    where
        wholeText = spanText s
        zipper = start wholeText
        levels = spanBiDiLevels s
        run acc pr = let t = preceding (PR.zipper pr) in
            ( acc + lengthWord8 t
            , Run
                { runOffsetInSpan = acc
                , runText = t
                , runLevel = PR.level pr
                , runDirection = levelDirectionH $ PR.level pr
                , runScript = Just $ PR.script pr
                , runHardBreak = False
                }
            )

protoRuns :: Zipper -> TextLevels -> [ProtoRun]
protoRuns z bl = reverse $ protoRuns' z bl []

protoRuns' :: Zipper -> TextLevels -> [ProtoRun] -> [ProtoRun]
protoRuns' curZipper curLevels curRuns = case considerNext curZipper of
    Nothing -> curRuns
    Just choice ->
        let headRun :| tailRuns = foldRun (choice, curLevels) curRuns
        in protoRuns' (PR.zipper headRun) curLevels (headRun : tailRuns)

foldRun :: (ZipperChoice, TextLevels) -> [ProtoRun] -> NonEmpty ProtoRun

-- If there are no runs, create a new run with a single character.
foldRun (x, bl) [] = ProtoRun (continuingRun x) lvls lvl s :| []
    where
        lvl = headLevel bl
        lvls = tailLevels bl
        s = charScript (nextChar x)

foldRun (x, _) (previousRun : tailRuns) =
    case (mergeLevels l1 l2, mergeScripts s1 s2) of
        (Merged l, Merged s) ->
            ProtoRun (continuingRun x) bl' l s :| tailRuns
        _ ->
            ProtoRun (startingNewRun x) bl' l2 s2 :| previousRun : tailRuns
    where
        bl = PR.followingLevels previousRun
        l1 = PR.level previousRun
        s1 = PR.script previousRun
        l2 = headLevel bl
        s2 = charScript (nextChar x)
        bl' = tailLevels bl

mergeLevels :: Level -> Level -> Merged Level
mergeLevels l1 l2
    | l1 == l2 = Merged l1
    | otherwise = Incompatible

-- TODO: Implement proper inheritance rules.
mergeScripts :: ScriptCode -> ScriptCode -> Merged ScriptCode
mergeScripts "Zyyy" s2 = Merged s2
mergeScripts s1 "Zyyy" = Merged s1
mergeScripts s1 "Zinh" = Merged s1
mergeScripts s1 s2
    | s1 == s2 = Merged s1
    | otherwise = Incompatible