{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Parser.Token.Style
-- Copyright   :  (c) Edward Kmett 2011-2012
-- License     :  BSD3
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- A toolbox for specifying comment and identifier styles
--
-- This must be imported directly as it is not re-exported elsewhere
--
-----------------------------------------------------------------------------
module Text.Parser.Token.Style
  (
  -- * Comment and white space styles
    CommentStyle(..)
  -- ** Lenses
  , commentStart
  , commentEnd
  , commentLine
  , commentNesting
  -- ** Common Comment Styles
  , emptyCommentStyle
  , javaCommentStyle
  , scalaCommentStyle
  , haskellCommentStyle
  , buildSomeSpaceParser
  -- * Identifier Styles
  , emptyIdents, haskellIdents, haskell98Idents
  -- * Operator Styles
  , emptyOps, haskellOps, haskell98Ops
  ) where

import Control.Applicative
import Control.Monad (void)
import qualified Data.HashSet as HashSet
import Data.HashSet (HashSet)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.Data
import Text.Parser.Combinators
import Text.Parser.Char
import Text.Parser.Token
import Text.Parser.Token.Highlight
import Data.List (nub)

-- | How to deal with comments.
data CommentStyle = CommentStyle
  { CommentStyle -> String
_commentStart   :: String -- ^ String that starts a multiline comment
  , CommentStyle -> String
_commentEnd     :: String -- ^ String that ends a multiline comment
  , CommentStyle -> String
_commentLine    :: String -- ^ String that starts a single line comment
  , CommentStyle -> Bool
_commentNesting :: Bool   -- ^ Can we nest multiline comments?
  } deriving (CommentStyle -> CommentStyle -> Bool
(CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool) -> Eq CommentStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentStyle -> CommentStyle -> Bool
== :: CommentStyle -> CommentStyle -> Bool
$c/= :: CommentStyle -> CommentStyle -> Bool
/= :: CommentStyle -> CommentStyle -> Bool
Eq,Eq CommentStyle
Eq CommentStyle =>
(CommentStyle -> CommentStyle -> Ordering)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> CommentStyle)
-> (CommentStyle -> CommentStyle -> CommentStyle)
-> Ord CommentStyle
CommentStyle -> CommentStyle -> Bool
CommentStyle -> CommentStyle -> Ordering
CommentStyle -> CommentStyle -> CommentStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommentStyle -> CommentStyle -> Ordering
compare :: CommentStyle -> CommentStyle -> Ordering
$c< :: CommentStyle -> CommentStyle -> Bool
< :: CommentStyle -> CommentStyle -> Bool
$c<= :: CommentStyle -> CommentStyle -> Bool
<= :: CommentStyle -> CommentStyle -> Bool
$c> :: CommentStyle -> CommentStyle -> Bool
> :: CommentStyle -> CommentStyle -> Bool
$c>= :: CommentStyle -> CommentStyle -> Bool
>= :: CommentStyle -> CommentStyle -> Bool
$cmax :: CommentStyle -> CommentStyle -> CommentStyle
max :: CommentStyle -> CommentStyle -> CommentStyle
$cmin :: CommentStyle -> CommentStyle -> CommentStyle
min :: CommentStyle -> CommentStyle -> CommentStyle
Ord,Int -> CommentStyle -> ShowS
[CommentStyle] -> ShowS
CommentStyle -> String
(Int -> CommentStyle -> ShowS)
-> (CommentStyle -> String)
-> ([CommentStyle] -> ShowS)
-> Show CommentStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentStyle -> ShowS
showsPrec :: Int -> CommentStyle -> ShowS
$cshow :: CommentStyle -> String
show :: CommentStyle -> String
$cshowList :: [CommentStyle] -> ShowS
showList :: [CommentStyle] -> ShowS
Show,ReadPrec [CommentStyle]
ReadPrec CommentStyle
Int -> ReadS CommentStyle
ReadS [CommentStyle]
(Int -> ReadS CommentStyle)
-> ReadS [CommentStyle]
-> ReadPrec CommentStyle
-> ReadPrec [CommentStyle]
-> Read CommentStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommentStyle
readsPrec :: Int -> ReadS CommentStyle
$creadList :: ReadS [CommentStyle]
readList :: ReadS [CommentStyle]
$creadPrec :: ReadPrec CommentStyle
readPrec :: ReadPrec CommentStyle
$creadListPrec :: ReadPrec [CommentStyle]
readListPrec :: ReadPrec [CommentStyle]
Read,Typeable CommentStyle
Typeable CommentStyle =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CommentStyle -> c CommentStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CommentStyle)
-> (CommentStyle -> Constr)
-> (CommentStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CommentStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CommentStyle))
-> ((forall b. Data b => b -> b) -> CommentStyle -> CommentStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CommentStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> CommentStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CommentStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle)
-> Data CommentStyle
CommentStyle -> Constr
CommentStyle -> DataType
(forall b. Data b => b -> b) -> CommentStyle -> CommentStyle
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CommentStyle -> u
forall u. (forall d. Data d => d -> u) -> CommentStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentStyle -> c CommentStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentStyle)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentStyle -> c CommentStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentStyle -> c CommentStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentStyle
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentStyle
$ctoConstr :: CommentStyle -> Constr
toConstr :: CommentStyle -> Constr
$cdataTypeOf :: CommentStyle -> DataType
dataTypeOf :: CommentStyle -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentStyle)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentStyle)
$cgmapT :: (forall b. Data b => b -> b) -> CommentStyle -> CommentStyle
gmapT :: (forall b. Data b => b -> b) -> CommentStyle -> CommentStyle
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CommentStyle -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CommentStyle -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentStyle -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentStyle -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
Data,Typeable)

-- | This is a lens that can edit the string that starts a multiline comment.
--
-- @'commentStart' :: Lens' 'CommentStyle' 'String'@
commentStart :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
commentStart :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> CommentStyle -> f CommentStyle
commentStart String -> f String
f (CommentStyle String
s String
e String
l Bool
n) = (\String
s' -> String -> String -> String -> Bool -> CommentStyle
CommentStyle String
s' String
e String
l Bool
n) (String -> CommentStyle) -> f String -> f CommentStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
s
{-# INLINE commentStart #-}

-- | This is a lens that can edit the string that ends a multiline comment.
--
-- @'commentEnd' :: Lens' 'CommentStyle' 'String'@
commentEnd :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
commentEnd :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> CommentStyle -> f CommentStyle
commentEnd String -> f String
f (CommentStyle String
s String
e String
l Bool
n) = (\String
e' -> String -> String -> String -> Bool -> CommentStyle
CommentStyle String
s String
e' String
l Bool
n) (String -> CommentStyle) -> f String -> f CommentStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
e
{-# INLINE commentEnd #-}

-- | This is a lens that can edit the string that starts a single line comment.
--
-- @'commentLine' :: Lens' 'CommentStyle' 'String'@
commentLine :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
commentLine :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> CommentStyle -> f CommentStyle
commentLine String -> f String
f (CommentStyle String
s String
e String
l Bool
n) = (\String
l' -> String -> String -> String -> Bool -> CommentStyle
CommentStyle String
s String
e String
l' Bool
n) (String -> CommentStyle) -> f String -> f CommentStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
l
{-# INLINE commentLine #-}

-- | This is a lens that can edit whether we can nest multiline comments.
--
-- @'commentNesting' :: Lens' 'CommentStyle' 'Bool'@
commentNesting :: Functor f => (Bool -> f Bool) -> CommentStyle -> f CommentStyle
commentNesting :: forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CommentStyle -> f CommentStyle
commentNesting Bool -> f Bool
f (CommentStyle String
s String
e String
l Bool
n) = String -> String -> String -> Bool -> CommentStyle
CommentStyle String
s String
e String
l (Bool -> CommentStyle) -> f Bool -> f CommentStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
n
{-# INLINE commentNesting #-}

-- | No comments at all
emptyCommentStyle :: CommentStyle
emptyCommentStyle :: CommentStyle
emptyCommentStyle   = String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"" String
"" String
"" Bool
True

-- | Use java-style comments
javaCommentStyle :: CommentStyle
javaCommentStyle :: CommentStyle
javaCommentStyle = String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"/*" String
"*/" String
"//" Bool
False

-- | Use scala-style comments
scalaCommentStyle :: CommentStyle
scalaCommentStyle :: CommentStyle
scalaCommentStyle = String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"/*" String
"*/" String
"//" Bool
True

-- | Use haskell-style comments
haskellCommentStyle :: CommentStyle
haskellCommentStyle :: CommentStyle
haskellCommentStyle = String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"{-" String
"-}" String
"--" Bool
True

-- | Use this to easily build the definition of whiteSpace for your MonadParser
--   given a comment style and an underlying someWhiteSpace parser
buildSomeSpaceParser :: forall m. CharParsing m => m () -> CommentStyle -> m ()
buildSomeSpaceParser :: forall (m :: * -> *). CharParsing m => m () -> CommentStyle -> m ()
buildSomeSpaceParser m ()
simpleSpace (CommentStyle String
startStyle String
endStyle String
lineStyle Bool
nestingStyle)
  | Bool
noLine Bool -> Bool -> Bool
&& Bool
noMulti  = m () -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
  | Bool
noLine             = m () -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
multiLineComment m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
  | Bool
noMulti            = m () -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
oneLineComment m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
  | Bool
otherwise          = m () -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
oneLineComment m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
multiLineComment m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
  where
    noLine :: Bool
noLine  = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
lineStyle
    noMulti :: Bool
noMulti = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
startStyle

    oneLineComment, multiLineComment, inComment, inCommentMulti :: m ()
    oneLineComment :: m ()
oneLineComment = m String -> m String
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
lineStyle) m String -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Char -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany ((Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
    multiLineComment :: m ()
multiLineComment = m String -> m String
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
startStyle) m String -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inComment
    inComment :: m ()
inComment = if Bool
nestingStyle then m ()
inCommentMulti else m ()
inCommentSingle
    inCommentMulti :: m ()
inCommentMulti
      =   m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m String
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
endStyle))
      m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
multiLineComment m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentMulti
      m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
startEnd) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentMulti
      m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
startEnd m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentMulti
      m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end of comment"

    startEnd :: String
startEnd = ShowS
forall a. Eq a => [a] -> [a]
nub (String
endStyle String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
startStyle)

    inCommentSingle :: m ()
    inCommentSingle :: m ()
inCommentSingle
      =   m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m String
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
endStyle))
      m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char -> m ()
forall a. m a -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
startEnd) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentSingle
      m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
startEnd m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentSingle
      m () -> String -> m ()
forall a. m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end of comment"

set :: [String] -> HashSet String
set :: [String] -> HashSet String
set = [String] -> HashSet String
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList

-- | A simple operator style based on haskell with no reserved operators
emptyOps :: TokenParsing m => IdentifierStyle m
emptyOps :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyOps = IdentifierStyle
  { _styleName :: String
_styleName     = String
"operator"
  , _styleStart :: m Char
_styleStart    = IdentifierStyle m -> m Char
forall (m :: * -> *). IdentifierStyle m -> m Char
_styleLetter IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyOps
  , _styleLetter :: m Char
_styleLetter   = String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
":!#$%&*+./<=>?@\\^|-~"
  , _styleReserved :: HashSet String
_styleReserved = HashSet String
forall a. Monoid a => a
mempty
  , _styleHighlight :: Highlight
_styleHighlight = Highlight
Operator
  , _styleReservedHighlight :: Highlight
_styleReservedHighlight = Highlight
ReservedOperator
  }
-- | A simple operator style based on haskell with the operators from Haskell 98.
haskell98Ops, haskellOps :: TokenParsing m => IdentifierStyle m
haskell98Ops :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Ops = IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyOps
  { _styleReserved = set ["::","..","=","\\","|","<-","->","@","~","=>"]
  }
haskellOps :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskellOps = IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Ops

-- | A simple identifier style based on haskell with no reserve words
emptyIdents :: TokenParsing m => IdentifierStyle m
emptyIdents :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyIdents = IdentifierStyle
  { _styleName :: String
_styleName     = String
"identifier"
  , _styleStart :: m Char
_styleStart    = m Char
forall (m :: * -> *). CharParsing m => m Char
letter m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'_'
  , _styleLetter :: m Char
_styleLetter   = m Char
forall (m :: * -> *). CharParsing m => m Char
alphaNum m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
"_'"
  , _styleReserved :: HashSet String
_styleReserved = [String] -> HashSet String
set []
  , _styleHighlight :: Highlight
_styleHighlight = Highlight
Identifier
  , _styleReservedHighlight :: Highlight
_styleReservedHighlight = Highlight
ReservedIdentifier
  }

-- | A simple identifier style based on haskell with only the reserved words from Haskell 98.
haskell98Idents :: TokenParsing m => IdentifierStyle m
haskell98Idents :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Idents = IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyIdents
  { _styleReserved = set haskell98ReservedIdents }

-- | A simple identifier style based on haskell with the reserved words from Haskell 98 and some common extensions.
haskellIdents :: TokenParsing m => IdentifierStyle m
haskellIdents :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskellIdents = IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Idents
  { _styleLetter   = _styleLetter haskell98Idents <|> char '#'
  , _styleReserved = set $ haskell98ReservedIdents ++
      ["foreign","import","export","primitive","_ccall_","_casm_" ,"forall"]
  }

haskell98ReservedIdents :: [String]
haskell98ReservedIdents :: [String]
haskell98ReservedIdents =
  [String
"let",String
"in",String
"case",String
"of",String
"if",String
"then",String
"else",String
"data",String
"type"
  ,String
"class",String
"default",String
"deriving",String
"do",String
"import",String
"infix"
  ,String
"infixl",String
"infixr",String
"instance",String
"module",String
"newtype"
  ,String
"where",String
"primitive" -- "as","qualified","hiding"
  ]