Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Get pragmas from a EpaCommentTok, not a String #820

Merged
merged 2 commits into from
Feb 29, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 24 additions & 2 deletions src/HIndent/Ast/FileHeaderPragma.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,13 @@ module HIndent.Ast.FileHeaderPragma
, mkFileHeaderPragma
) where

import Data.Bifunctor
import Data.Char
import Data.List
import Data.List.Split
import qualified GHC.Hs as GHC
import HIndent.Ast.NodeComments
import HIndent.Pragma
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
Expand All @@ -17,5 +23,21 @@ instance CommentExtraction FileHeaderPragma where
instance Pretty FileHeaderPragma where
pretty' (FileHeaderPragma x) = string x

mkFileHeaderPragma :: String -> FileHeaderPragma
mkFileHeaderPragma = FileHeaderPragma
mkFileHeaderPragma :: GHC.EpaCommentTok -> Maybe FileHeaderPragma
mkFileHeaderPragma =
fmap (FileHeaderPragma . uncurry constructPragma) . extractPragma

-- | This function returns a 'Just' value with the pragma
-- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it
-- returns a 'Nothing'.
extractPragma :: GHC.EpaCommentTok -> Maybe (String, [String])
extractPragma (GHC.EpaBlockComment c) =
second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c
where
strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
extractPragma _ = Nothing

-- | Construct a pragma.
constructPragma :: String -> [String] -> String
constructPragma optionOrPragma xs =
"{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"
37 changes: 5 additions & 32 deletions src/HIndent/Ast/FileHeaderPragma/Collection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,16 +6,11 @@ module HIndent.Ast.FileHeaderPragma.Collection
, hasPragmas
) where

import Data.Bifunctor
import Data.Char
import Data.List
import Data.List.Split
import Data.Maybe
import Generics.SYB
import HIndent.Ast.FileHeaderPragma
import HIndent.Ast.NodeComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import HIndent.Pragma
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
Expand All @@ -31,37 +26,15 @@ instance Pretty FileHeaderPragmaCollection where

mkFileHeaderPragmaCollection :: GHC.HsModule' -> FileHeaderPragmaCollection
mkFileHeaderPragmaCollection =
FileHeaderPragmaCollection . fmap mkFileHeaderPragma . collectPragmas
FileHeaderPragmaCollection
. mapMaybe mkFileHeaderPragma
. collectBlockComments

hasPragmas :: FileHeaderPragmaCollection -> Bool
hasPragmas (FileHeaderPragmaCollection xs) = not $ null xs

-- | This function collects pragma comments from the
-- given module and modifies them into 'String's.
--
-- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ ->
-- @LANGUAGE@).
collectPragmas :: GHC.HsModule' -> [String]
collectPragmas =
fmap (uncurry constructPragma)
. mapMaybe extractPragma
. listify isBlockComment
. GHC.getModuleAnn

-- | This function returns a 'Just' value with the pragma
-- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it
-- returns a 'Nothing'.
extractPragma :: GHC.EpaCommentTok -> Maybe (String, [String])
extractPragma (GHC.EpaBlockComment c) =
second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c
where
strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
extractPragma _ = Nothing

-- | Construct a pragma.
constructPragma :: String -> [String] -> String
constructPragma optionOrPragma xs =
"{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"
collectBlockComments :: GHC.HsModule' -> [GHC.EpaCommentTok]
collectBlockComments = listify isBlockComment . GHC.getModuleAnn

-- | Checks if the given comment is a block one.
isBlockComment :: GHC.EpaCommentTok -> Bool
Expand Down
Loading