Whitespaces.hs

module Compiler.Lexer.Whitespaces where

import Common
import Control.Applicative
import Data.Text as T hiding (length)
import Parser
import Test.Common

data Whitespace
  = Space Int
  | Tab Int
  | NewLine Int
  deriving (Show, Eq)

instance HasParser Whitespace where
  parser
    =  spaceParser <|> tabParser <|> newlineParser
    where
      spaceParser = ((\c -> Space (length c)) <$> (some (pChar ' ')))
      tabParser = ((\c -> Tab (length c)) <$> (some (pChar '\t')))
      newlineParser = do
        nls <- some (pChar '\n')
        let lc = length nls
        incLine lc
        pure $ NewLine lc

instance ToSource Whitespace where
  toSource = \case
    Space c   -> T.replicate c " "
    Tab c     -> T.replicate c "\t"
    NewLine c -> T.replicate c "\n"

instance HasGen Whitespace where
  getGen = choice
    [ Space <$> (int (linear 1 10))
    , Tab <$> (int (linear 1 10))
    , NewLine <$> (int (linear 1 10))
    ]