{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#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 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)
data =
{ :: String
, :: String
, :: String
, :: Bool
} deriving (CommentStyle -> CommentStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentStyle -> CommentStyle -> Bool
$c/= :: CommentStyle -> CommentStyle -> Bool
== :: CommentStyle -> CommentStyle -> Bool
$c== :: CommentStyle -> CommentStyle -> Bool
Eq,Eq 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
min :: CommentStyle -> CommentStyle -> CommentStyle
$cmin :: CommentStyle -> CommentStyle -> CommentStyle
max :: CommentStyle -> CommentStyle -> CommentStyle
$cmax :: CommentStyle -> CommentStyle -> CommentStyle
>= :: CommentStyle -> CommentStyle -> Bool
$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
compare :: CommentStyle -> CommentStyle -> Ordering
$ccompare :: CommentStyle -> CommentStyle -> Ordering
Ord,Int -> CommentStyle -> ShowS
[CommentStyle] -> ShowS
CommentStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentStyle] -> ShowS
$cshowList :: [CommentStyle] -> ShowS
show :: CommentStyle -> String
$cshow :: CommentStyle -> String
showsPrec :: Int -> CommentStyle -> ShowS
$cshowsPrec :: Int -> CommentStyle -> ShowS
Show,ReadPrec [CommentStyle]
ReadPrec CommentStyle
Int -> ReadS CommentStyle
ReadS [CommentStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommentStyle]
$creadListPrec :: ReadPrec [CommentStyle]
readPrec :: ReadPrec CommentStyle
$creadPrec :: ReadPrec CommentStyle
readList :: ReadS [CommentStyle]
$creadList :: ReadS [CommentStyle]
readsPrec :: Int -> ReadS CommentStyle
$creadsPrec :: Int -> ReadS CommentStyle
Read,Typeable 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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CommentStyle -> m CommentStyle
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CommentStyle -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CommentStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CommentStyle -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CommentStyle -> r
gmapT :: (forall b. Data b => b -> b) -> CommentStyle -> CommentStyle
$cgmapT :: (forall b. Data b => b -> b) -> CommentStyle -> CommentStyle
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CommentStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CommentStyle)
dataTypeOf :: CommentStyle -> DataType
$cdataTypeOf :: CommentStyle -> DataType
toConstr :: CommentStyle -> Constr
$ctoConstr :: CommentStyle -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CommentStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentStyle -> c CommentStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CommentStyle -> c CommentStyle
Data,Typeable)
commentStart :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
s
{-# INLINE commentStart #-}
commentEnd :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
e
{-# INLINE commentEnd #-}
commentLine :: Functor f => (String -> f String) -> CommentStyle -> f CommentStyle
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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
l
{-# INLINE commentLine #-}
commentNesting :: Functor f => (Bool -> f Bool) -> CommentStyle -> f CommentStyle
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
n
{-# INLINE commentNesting #-}
emptyCommentStyle :: CommentStyle
= String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"" String
"" String
"" Bool
True
javaCommentStyle :: CommentStyle
= String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"/*" String
"*/" String
"//" Bool
False
scalaCommentStyle :: CommentStyle
= String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"/*" String
"*/" String
"//" Bool
True
haskellCommentStyle :: CommentStyle
= String -> String -> String -> Bool -> CommentStyle
CommentStyle String
"{-" String
"-}" String
"--" Bool
True
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 = forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
| Bool
noLine = forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
multiLineComment forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
| Bool
noMulti = forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
oneLineComment forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
| Bool
otherwise = forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (m ()
simpleSpace forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
oneLineComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
multiLineComment forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"")
where
noLine :: Bool
noLine = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
lineStyle
noMulti :: Bool
noMulti = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
startStyle
oneLineComment, multiLineComment, inComment, inCommentMulti :: m ()
oneLineComment :: m ()
oneLineComment = forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (m :: * -> *). CharParsing m => String -> m String
string String
lineStyle) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
multiLineComment :: m ()
multiLineComment = forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (m :: * -> *). CharParsing m => String -> m String
string String
startStyle) 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
= forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (m :: * -> *). CharParsing m => String -> m String
string String
endStyle))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
multiLineComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentMulti
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
startEnd) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentMulti
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
startEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentMulti
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end of comment"
startEnd :: String
startEnd = forall a. Eq a => [a] -> [a]
nub (String
endStyle forall a. [a] -> [a] -> [a]
++ String
startStyle)
inCommentSingle :: m ()
inCommentSingle :: m ()
inCommentSingle
= forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (m :: * -> *). CharParsing m => String -> m String
string String
endStyle))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m ()
skipSome (forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
startEnd) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentSingle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
startEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
inCommentSingle
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end of comment"
set :: [String] -> HashSet String
set :: [String] -> HashSet String
set = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
emptyOps :: TokenParsing m => IdentifierStyle m
emptyOps :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyOps = IdentifierStyle
{ _styleName :: String
_styleName = String
"operator"
, _styleStart :: m Char
_styleStart = forall (m :: * -> *). IdentifierStyle m -> m Char
_styleLetter forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyOps
, _styleLetter :: m Char
_styleLetter = forall (m :: * -> *). CharParsing m => String -> m Char
oneOf String
":!#$%&*+./<=>?@\\^|-~"
, _styleReserved :: HashSet String
_styleReserved = forall a. Monoid a => a
mempty
, _styleHighlight :: Highlight
_styleHighlight = Highlight
Operator
, _styleReservedHighlight :: Highlight
_styleReservedHighlight = Highlight
ReservedOperator
}
haskell98Ops, haskellOps :: TokenParsing m => IdentifierStyle m
haskell98Ops :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Ops = forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyOps
{ _styleReserved :: HashSet String
_styleReserved = [String] -> HashSet String
set [String
"::",String
"..",String
"=",String
"\\",String
"|",String
"<-",String
"->",String
"@",String
"~",String
"=>"]
}
haskellOps :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskellOps = forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Ops
emptyIdents :: TokenParsing m => IdentifierStyle m
emptyIdents :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyIdents = IdentifierStyle
{ _styleName :: String
_styleName = String
"identifier"
, _styleStart :: m Char
_styleStart = forall (m :: * -> *). CharParsing m => m Char
letter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'_'
, _styleLetter :: m Char
_styleLetter = forall (m :: * -> *). CharParsing m => m Char
alphaNum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
}
haskell98Idents :: TokenParsing m => IdentifierStyle m
haskell98Idents :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Idents = forall (m :: * -> *). TokenParsing m => IdentifierStyle m
emptyIdents
{ _styleReserved :: HashSet String
_styleReserved = [String] -> HashSet String
set [String]
haskell98ReservedIdents }
haskellIdents :: TokenParsing m => IdentifierStyle m
haskellIdents :: forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskellIdents = forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Idents
{ _styleLetter :: m Char
_styleLetter = forall (m :: * -> *). IdentifierStyle m -> m Char
_styleLetter forall (m :: * -> *). TokenParsing m => IdentifierStyle m
haskell98Idents forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'#'
, _styleReserved :: HashSet String
_styleReserved = [String] -> HashSet String
set forall a b. (a -> b) -> a -> b
$ [String]
haskell98ReservedIdents forall a. [a] -> [a] -> [a]
++
[String
"foreign",String
"import",String
"export",String
"primitive",String
"_ccall_",String
"_casm_" ,String
"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"
]