{-# LANGUAGE TypeFamilies #-}
module Parsers.Utils.Handrolled where

import Data.Bool (Bool)
import Data.Char (Char)
import Data.Maybe (Maybe(..))
import Data.Word (Word8)
import qualified Data.ByteString as BS
import qualified Data.Text as T

-- * Class 'Inputable'
class Inputable inp where
  type Token inp
  null :: inp -> Bool
  empty :: inp
  uncons :: inp -> Maybe (Token inp, inp)
instance Inputable T.Text where
  type Token T.Text = Char
  null :: Text -> Bool
null = Text -> Bool
T.null
  empty :: Text
empty = Text
T.empty
  uncons :: Text -> Maybe (Token Text, Text)
uncons = Text -> Maybe (Char, Text)
Text -> Maybe (Token Text, Text)
T.uncons
instance Inputable BS.ByteString where
  type Token BS.ByteString = Word8
  null :: ByteString -> Bool
null = ByteString -> Bool
BS.null
  empty :: ByteString
empty = ByteString
BS.empty
  uncons :: ByteString -> Maybe (Token ByteString, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
ByteString -> Maybe (Token ByteString, ByteString)
BS.uncons