content: {-# LANGUAGE CPP #-}
  
  -- | Pragma-related functions.
  module HIndent.Pragma
    ( extractPragmasFromCode
    , extractPragmaNameAndElement
    , pragmaExists
    , isPragma
    ) where
  
  import Data.Bifunctor
  import Data.Char
  import Data.Generics
  import Data.List (intercalate)
  import Data.List.Split
  import Data.Maybe
  import GHC.Hs
  import GHC.Parser.Lexer
  import HIndent.GhcLibParserWrapper.GHC.Hs
  import HIndent.Parse
  import Text.Regex.TDFA hiding (empty)
  
  -- | Extracts all pragmas from the given source code.
  --
  -- FIXME: The function is slow because it lexicographically analyzes the
  -- given source code. An alternative way is to use regular expressions.
  -- However, this method cannot determine if what appears to be a pragma is
  -- really a pragma, or requires complex regular expressions. For example,
  -- @{-\n\n{-# LANGUAGE CPP #-}\n\n-}@ is not a pragma, but is likely to be
  -- recognized as such.
  extractPragmasFromCode :: String -> [(String, String)] -- ^ [(Pragma's name (e.g., @"LANGUAGE"@), Pragma's element (e.g., @"CPP, DerivingVia"@))]
  extractPragmasFromCode =
    mapMaybe extractPragmaNameAndElement . mapMaybe extractBlockComment . lexCode
    where
      extractBlockComment (ITblockComment c _) = Just c
      extractBlockComment _ = Nothing
  
  -- | Extracts the pragma's name and its element from the given pragma.
  --
  -- This function returns a 'Nothing' if it fails to extract them.
  extractPragmaNameAndElement :: String -> Maybe (String, String) -- ^ [(Pragma's name (e.g., @"LANGUAGE"@), Pragma's element (e.g., @"CPP, DerivingVia"@))]
  extractPragmaNameAndElement l
    | (_, _, _, [name, element]) <-
        match pragmaRegex l :: (String, String, String, [String]) =
      Just (name, element)
  extractPragmaNameAndElement _ = Nothing
  
  -- | This function returns a 'True' if the passed 'EpaCommentTok' is
  -- a pragma. Otherwise, it returns a 'False'.
  isPragma :: EpaCommentTok -> Bool
  isPragma (EpaBlockComment c) = match pragmaRegex c
  isPragma _ = False
  
  -- | A regex to match against a pragma.
  pragmaRegex :: Regex
  pragmaRegex =
    makeRegexOpts
      compOption
      execOption
      "^{-#[[:space:]]*([^[:space:]]+)[[:space:]]+([^#]+)#-}"
  
  -- | The option for matching against a pragma.
  execOption :: ExecOption
  execOption = ExecOption {captureGroups = True}
  
  -- | The option for matching against a pragma.
  --
  -- 'multiline' is set to 'False' to match against multiline pragmas, e.g.,
  -- @{-# LANGUAGE CPP\nOverloadedStrings #-}@.
  compOption :: CompOption
  compOption =
    CompOption
      { caseSensitive = True
      , multiline = False
      , rightAssoc = True
      , newSyntax = True
      , lastStarGreedy = True
      }
  
  -- | This function returns a 'True' if the module has pragmas.
  -- Otherwise, it returns a 'False'.
  pragmaExists :: HsModule' -> Bool
  pragmaExists = not . null . collectPragmas
  
  -- | 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 :: HsModule' -> [String]
  collectPragmas =
    fmap (uncurry constructPragma)
      . mapMaybe extractPragma
      . listify isBlockComment
      . 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 :: EpaCommentTok -> Maybe (String, [String])
  extractPragma (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 ++ " #-}"
  
  -- | Checks if the given comment is a block one.
  isBlockComment :: EpaCommentTok -> Bool
  isBlockComment EpaBlockComment {} = True
  isBlockComment _ = False
  