#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#endif
module Text.Parser.Token.Style
(
CommentStyle(..)
, commentStart
, commentEnd
, commentLine
, commentNesting
, emptyCommentStyle
, javaCommentStyle
, scalaCommentStyle
, haskellCommentStyle
, buildSomeSpaceParser
, emptyIdents, haskellIdents, haskell98Idents
, emptyOps, haskellOps, haskell98Ops
) where
import Control.Applicative
import qualified Data.HashSet as HashSet
import Data.HashSet (HashSet)
import Data.Monoid
import Data.Data
import Text.Parser.Combinators
import Text.Parser.Char
import Text.Parser.Token
import Text.Parser.Token.Highlight
import Data.List (nub)
data CommentStyle = CommentStyle
{ _commentStart :: String
, _commentEnd :: String
, _commentLine :: String
, _commentNesting :: Bool
} deriving (Eq,Ord,Show,Read,Data,Typeable)
commentStart :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
commentStart f (CommentStyle s e l n) = (\s' -> CommentStyle s' e l n) <$> f s
commentEnd :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
commentEnd f (CommentStyle s e l n) = (\e' -> CommentStyle s e' l n) <$> f e
commentLine :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
commentLine f (CommentStyle s e l n) = (\l' -> CommentStyle s e l' n) <$> f l
commentNesting :: Functor f => (Bool -> f Bool) -> CommentStyle -> f CommentStyle
commentNesting f (CommentStyle s e l n) = CommentStyle s e l <$> f n
emptyCommentStyle :: CommentStyle
emptyCommentStyle = CommentStyle "" "" "" True
javaCommentStyle :: CommentStyle
javaCommentStyle = CommentStyle "/*" "*/" "//" False
scalaCommentStyle :: CommentStyle
scalaCommentStyle = CommentStyle "/*" "*/" "//" True
haskellCommentStyle :: CommentStyle
haskellCommentStyle = CommentStyle "{-" "-}" "--" True
buildSomeSpaceParser :: CharParsing m => m () -> CommentStyle -> m ()
buildSomeSpaceParser simpleSpace (CommentStyle startStyle endStyle lineStyle nestingStyle)
| noLine && noMulti = skipSome (simpleSpace <?> "")
| noLine = skipSome (simpleSpace <|> multiLineComment <?> "")
| noMulti = skipSome (simpleSpace <|> oneLineComment <?> "")
| otherwise = skipSome (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")
where
noLine = null lineStyle
noMulti = null startStyle
oneLineComment = try (string lineStyle) *> skipMany (satisfy (/= '\n'))
multiLineComment = try (string startStyle) *> inComment
inComment = if nestingStyle then inCommentMulti else inCommentSingle
inCommentMulti
= () <$ try (string endStyle)
<|> multiLineComment *> inCommentMulti
<|> skipSome (noneOf startEnd) *> inCommentMulti
<|> oneOf startEnd *> inCommentMulti
<?> "end of comment"
startEnd = nub (endStyle ++ startStyle)
inCommentSingle
= () <$ try (string endStyle)
<|> skipSome (noneOf startEnd) *> inCommentSingle
<|> oneOf startEnd *> inCommentSingle
<?> "end of comment"
set :: [String] -> HashSet String
set = HashSet.fromList
emptyOps :: TokenParsing m => IdentifierStyle m
emptyOps = IdentifierStyle
{ _styleName = "operator"
, _styleStart = _styleLetter emptyOps
, _styleLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
, _styleReserved = mempty
, _styleHighlight = Operator
, _styleReservedHighlight = ReservedOperator
}
haskell98Ops, haskellOps :: TokenParsing m => IdentifierStyle m
haskell98Ops = emptyOps
{ _styleReserved = set ["::","..","=","\\","|","<-","->","@","~","=>"]
}
haskellOps = haskell98Ops
emptyIdents :: TokenParsing m => IdentifierStyle m
emptyIdents = IdentifierStyle
{ _styleName = "identifier"
, _styleStart = letter <|> char '_'
, _styleLetter = alphaNum <|> oneOf "_'"
, _styleReserved = set []
, _styleHighlight = Identifier
, _styleReservedHighlight = ReservedIdentifier
}
haskell98Idents :: TokenParsing m => IdentifierStyle m
haskell98Idents = emptyIdents
{ _styleReserved = set haskell98ReservedIdents }
haskellIdents :: TokenParsing m => IdentifierStyle m
haskellIdents = haskell98Idents
{ _styleLetter = _styleLetter haskell98Idents <|> char '#'
, _styleReserved = set $ haskell98ReservedIdents ++
["foreign","import","export","primitive","_ccall_","_casm_" ,"forall"]
}
haskell98ReservedIdents :: [String]
haskell98ReservedIdents =
["let","in","case","of","if","then","else","data","type"
,"class","default","deriving","do","import","infix"
,"infixl","infixr","instance","module","newtype"
,"where","primitive"
]