module GHC.Util.ApiAnnotation (
comment, commentText, isCommentMultiline
, pragmas, flags, langExts
, mkFlags, mkLangExts
) where
import ApiAnnotation
import SrcLoc
import Control.Applicative
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.List.Extra
trimCommentStart :: String -> String
s :: String
s
| Just s :: String
s <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "{-" String
s = String
s
| Just s :: String
s <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "--" String
s = String
s
| Bool
otherwise = String
s
trimCommentEnd :: String -> String
s :: String
s
| Just s :: String
s <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix "-}" String
s = String
s
| Bool
otherwise = String
s
trimCommentDelims :: String -> String
= String -> String
trimCommentEnd (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trimCommentStart
comment :: Located AnnotationComment -> String
(L _ (AnnBlockComment s :: String
s)) = String
s
comment (L _ (AnnLineComment s :: String
s)) = String
s
comment (L _ (AnnDocOptions s :: String
s)) = String
s
comment (L _ (AnnDocCommentNamed s :: String
s)) = String
s
comment (L _ (AnnDocCommentPrev s :: String
s)) = String
s
comment (L _ (AnnDocCommentNext s :: String
s)) = String
s
comment (L _ (AnnDocSection _ s :: String
s)) = String
s
commentText :: Located AnnotationComment -> String
= String -> String
trimCommentDelims (String -> String)
-> (Located AnnotationComment -> String)
-> Located AnnotationComment
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located AnnotationComment -> String
comment
isCommentMultiline :: Located AnnotationComment -> Bool
(L _ (AnnBlockComment _)) = Bool
True
isCommentMultiline _ = Bool
False
pragmas :: ApiAnns -> [(Located AnnotationComment, String)]
pragmas :: ApiAnns -> [(Located AnnotationComment, String)]
pragmas anns :: ApiAnns
anns =
[(Located AnnotationComment, String)]
-> [(Located AnnotationComment, String)]
forall a. [a] -> [a]
reverse
[ (Located AnnotationComment
c, String
s) |
c :: Located AnnotationComment
c@(L _ (AnnBlockComment comm :: String
comm)) <- [Located AnnotationComment]
-> Maybe [Located AnnotationComment] -> [Located AnnotationComment]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Located AnnotationComment] -> [Located AnnotationComment])
-> Maybe [Located AnnotationComment] -> [Located AnnotationComment]
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> Map SrcSpan [Located AnnotationComment]
-> Maybe [Located AnnotationComment]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SrcSpan
noSrcSpan (ApiAnns -> Map SrcSpan [Located AnnotationComment]
forall a b. (a, b) -> b
snd ApiAnns
anns)
, let body :: String
body = String -> String
trimCommentDelims String
comm
, Just rest :: String
rest <- [String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix "#" (String -> Maybe String) -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "#" String
body]
, let s :: String
s = String -> String
trim String
rest
]
stripPrefixCI :: String -> String -> Maybe String
stripPrefixCI :: String -> String -> Maybe String
stripPrefixCI pref :: String
pref str :: String
str =
let pref' :: String
pref' = String -> String
lower String
pref
(str_pref :: String
str_pref, rest :: String
rest) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pref') String
str
in if String -> String
lower String
str_pref String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pref' then String -> Maybe String
forall a. a -> Maybe a
Just String
rest else Maybe String
forall a. Maybe a
Nothing
flags :: [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
flags :: [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
flags ps :: [(Located AnnotationComment, String)]
ps =
[(Located AnnotationComment
c, [String]
opts) | (c :: Located AnnotationComment
c, s :: String
s) <- [(Located AnnotationComment, String)]
ps
, Just rest :: String
rest <- [String -> String -> Maybe String
stripPrefixCI "OPTIONS_GHC " String
s
Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe String
stripPrefixCI "OPTIONS " String
s]
, let opts :: [String]
opts = String -> [String]
words String
rest]
langExts :: [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
langExts :: [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
langExts ps :: [(Located AnnotationComment, String)]
ps =
[(Located AnnotationComment
c, [String]
exts) | (c :: Located AnnotationComment
c, s :: String
s) <- [(Located AnnotationComment, String)]
ps
, Just rest :: String
rest <- [String -> String -> Maybe String
stripPrefixCI "LANGUAGE " String
s]
, let exts :: [String]
exts = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
trim (String -> String -> [String]
forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
splitOn "," String
rest)]
mkFlags :: SrcSpan -> [String] -> Located AnnotationComment
mkFlags :: SrcSpan -> [String] -> Located AnnotationComment
mkFlags loc :: SrcSpan
loc flags :: [String]
flags =
SrcSpan
-> SrcSpanLess (Located AnnotationComment)
-> Located AnnotationComment
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
LL SrcSpan
loc (SrcSpanLess (Located AnnotationComment)
-> Located AnnotationComment)
-> SrcSpanLess (Located AnnotationComment)
-> Located AnnotationComment
forall a b. (a -> b) -> a -> b
$ String -> AnnotationComment
AnnBlockComment ("{-# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ "OPTIONS_GHC " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
flags String -> String -> String
forall a. [a] -> [a] -> [a]
++ " #-}")
mkLangExts :: SrcSpan -> [String] -> Located AnnotationComment
mkLangExts :: SrcSpan -> [String] -> Located AnnotationComment
mkLangExts loc :: SrcSpan
loc exts :: [String]
exts =
SrcSpan
-> SrcSpanLess (Located AnnotationComment)
-> Located AnnotationComment
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
LL SrcSpan
loc (SrcSpanLess (Located AnnotationComment)
-> Located AnnotationComment)
-> SrcSpanLess (Located AnnotationComment)
-> Located AnnotationComment
forall a b. (a -> b) -> a -> b
$ String -> AnnotationComment
AnnBlockComment ("{-# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ "LANGUAGE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
exts String -> String -> String
forall a. [a] -> [a] -> [a]
++ " #-}")