module Token where

import ParseDecorate
import ParseTree

data Token s
  = Token
    { tSpaceBefore  :: [s]
    , tImage        :: s
    , tSpaceAfter   :: [s]
    }
  deriving Eq

instance (Symbol s) => Symbol (Token s) where
  symbolSize (Token _ im _)       = symbolSize im
  spaceBeforeSize (Token sb _ _)  = sum (map symbolSize sb)
  spaceAfterSize (Token _ _ sa)   = sum (map symbolSize sa)

instance Show s => Show (Token s) where
  showsPrec _ (Token _ im _) = (show im ++)
  showList [] = id
  showList [Token sb im sa] = (concatMap show sb ++) . (show im ++) . (concatMap show sa ++)
  showList ((Token sb im _):ts) = (concatMap show sb ++) . (show im ++) . showList ts

collapse :: (s -> Bool) -> [s] -> [Token s]
collapse space input = collapse' space xs yzs
  where
    (xs, yzs) = span space input

collapse' :: (s -> Bool) -> [s] -> [s] -> [Token s]
collapse' space spaceBefore input = output where
  output = if null input then [] else token : rest
  token = Token
    { tImage = head input
    , tSpaceBefore = spaceBefore
    , tSpaceAfter = spaceAfter
    }
  (spaceAfter, toProcess) = span space (tail input)
  rest = collapse' space spaceAfter toProcess

tsatisfy :: (s -> Bool) -> Parser (Token s) s w
tsatisfy pred = tImage <$> satisfy (\(Token _ im _) -> pred im)

lift :: Parser s a w -> Parser (Token s) a w
lift p toks = map ov res
  where
    res = p (map tImage toks)  -- [(([ParseTree s w], a), [s])]
    ov ((ps, x), _) = ((ps', x), toks')
      where (ps', toks') = overwriteManySymbols toks ps

(>&) :: Parser s [Token t] v -> Parser t a w -> [s] -> ParseTree (Token t) w
(p >& q) input = parseTree (lift q) $ run p input