{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies,
      MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-}

-- | This module provides the following instance:
--
-- * @('Functor' m, 'Monad' m, 'Show' s) => 'Parser' ('ParsecT' [s] () m)@
module Generics.Annotations.ParsecInstance (parsecSatisfy) where

import Generics.Annotations.Satisfy
import Generics.Annotations.Token
import Control.Monad.Identity
import qualified Text.Parsec as P
import qualified Text.Parsec.Pos as Pos

instance (Functor m, Monad m, Symbol s) => Satisfy (P.ParsecT [s] u m) where
  type Input (P.ParsecT [s] u m) = s
  satisfy   = parsecSatisfy

-- | Recognise a symbol matching a predicate.
parsecSatisfy :: (Monad m, Symbol s) => (s -> Bool) -> P.ParsecT [s] u m s
parsecSatisfy = P.tokenPrim (($ "") . unparseS . return) incPos . accept
  where
    incPos cur tok _ = Pos.incSourceColumn cur (spaceBeforeSize tok + symbolSize tok)
    accept ok tok = if ok tok then Just tok else Nothing