-- -*- Haskell -*-

-- | The include file for alex-generated syntax highlighters.  Because alex
-- declares its own types, any wrapper must have the highlighter in scope...
-- so it must be included.  Doubleplusyuck.
--
-- You will need to import qualified Data.ByteString.Char8, Yi.Vty, and Yi.Syntax.
--
-- You will need to define initState and stateToInit and type HlState
--
-- Your actions must have type String -> $state -> ($state, [Attr])

type AlexInput = Data.ByteString.Char8.ByteString

alexGetChar :: Data.ByteString.Char8.ByteString -> Maybe (Char, Data.ByteString.Char8.ByteString)
alexGetChar bs | Data.ByteString.Char8.null bs = Nothing
               | otherwise                     = Just (Data.ByteString.Char8.head bs,
                                                       Data.ByteString.Char8.tail bs)

alexInputPrevChar = undefined

c :: Yi.Vty.Attr -> Data.ByteString.Char8.ByteString -> a -> (a, [Yi.Vty.Attr])
c color str state = (state, replicate (Data.ByteString.Char8.length str) color)

m :: (s -> s) -> Yi.Vty.Attr -> Data.ByteString.Char8.ByteString -> s -> (s, [Yi.Vty.Attr])
m mod color str state = (mod state, replicate (Data.ByteString.Char8.length str) color)

highlighter :: Yi.Syntax.Highlighter (Data.ByteString.Char8.ByteString, HlState)
highlighter = Yi.Syntax.SynHL (Data.ByteString.Char8.empty , initState) fun funEOF
    where
      fun bs (scrap, st) = iter' full st
          where
            full = Data.ByteString.Char8.append scrap bs
            iter' bs s = case hl_alex_scan_tkn undefined bs 0# bs (iUnbox (stateToInit s)) AlexNone of
	                        (AlexNone, _) -> ((bs, s), [])
	                        (AlexLastSkip _ _, _) -> error "no skipping!"
                                (AlexLastAcc k input len, _) -> let (nst, attrs) = k (Data.ByteString.Char8.take len bs) s
                                                                    ((str', finst), fattr) = iter' input nst
                                                                in ((str', finst), attrs++fattr)
      funEOF (scrap, st) = snd (iter' scrap st)
          where
            iter' bs s = case alex_scan_tkn undefined bs 0# bs (iUnbox (stateToInit s)) AlexNone of
	                   (AlexNone, _) -> ((bs, s), [])
	                   (AlexLastSkip _ _, _) -> error "no skipping!"
                           (AlexLastAcc k input len, _) -> let (nst, attrs) = k (Data.ByteString.Char8.take len bs) s
                                                               ((str', finst), fattr) = iter' input nst
                                                           in ((str', finst), attrs++fattr)

-- Push the input through the DFA, remembering the most recent accepting
-- state it encountered.

-- Since the documented interface is insufficiently expressive, we have to use
-- the undocumented one :(

-- Our interface parses a token, but only if it is certain that the token is
-- the longest given available data.


hl_alex_scan_tkn user orig_input len input s last_acc =
  input `seq` -- strict in the input
  case s of 
    -1# -> (last_acc, input)
    _ -> hl_alex_scan_tkn' user orig_input len input s last_acc

hl_alex_scan_tkn' user orig_input len input s last_acc =
  let 
	new_acc = check_accs (alex_accept `quickIndex` (I# (s)))
  in
  new_acc `seq`
  case alexGetChar input of
     Nothing -> (AlexNone, input) -- fail on EOF - important!
     Just (c, new_input) -> 

	let
		base   = alexIndexInt32OffAddr alex_base s
		(I# (ord_c)) = ord c
		offset = (base +# ord_c)
		check  = alexIndexInt16OffAddr alex_check offset
		
		new_s = if (offset >=# 0#) && (check ==# ord_c)
			  then alexIndexInt16OffAddr alex_table offset
			  else alexIndexInt16OffAddr alex_deflt s
	in
	hl_alex_scan_tkn user orig_input (len +# 1#) new_input new_s new_acc

  where
	check_accs [] = last_acc
	check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))
	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (I# (len))
	check_accs (AlexAccPred a pred : rest)
	   | pred user orig_input (I# (len)) input
	   = AlexLastAcc a input (I# (len))
	check_accs (AlexAccSkipPred pred : rest)
	   | pred user orig_input (I# (len)) input
	   = AlexLastSkip input (I# (len))
	check_accs (_ : rest) = check_accs rest