{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Ormolu.Printer.Meat.Pragma
( p_pragmas,
)
where
import Data.Char (isUpper)
import Data.Maybe (listToMaybe)
import qualified Data.Set as S
import qualified Data.Text as T
import Ormolu.Parser.Pragma (Pragma (..))
import Ormolu.Printer.Combinators
data PragmaTy
= Language LanguagePragmaClass
| OptionsGHC
| OptionsHaddock
deriving (Eq, Ord)
data LanguagePragmaClass
=
Normal
|
Disabling
|
Final
deriving (Eq, Ord)
p_pragmas :: [Pragma] -> R ()
p_pragmas ps =
let prepare = concatMap $ \case
PragmaLanguage xs ->
let f x = (Language (classifyLanguagePragma x), x)
in f <$> xs
PragmaOptionsGHC x -> [(OptionsGHC, x)]
PragmaOptionsHaddock x -> [(OptionsHaddock, x)]
in mapM_ (uncurry p_pragma) (S.toAscList . S.fromList . prepare $ ps)
p_pragma :: PragmaTy -> String -> R ()
p_pragma ty c = do
txt "{-# "
txt $ case ty of
Language _ -> "LANGUAGE"
OptionsGHC -> "OPTIONS_GHC"
OptionsHaddock -> "OPTIONS_HADDOCK"
space
txt (T.pack c)
txt " #-}"
newline
classifyLanguagePragma :: String -> LanguagePragmaClass
classifyLanguagePragma = \case
"ImplicitPrelude" -> Final
"CUSKs" -> Final
str ->
case splitAt 2 str of
("No", rest) ->
case listToMaybe rest of
Nothing -> Normal
Just x ->
if isUpper x
then Disabling
else Normal
_ -> Normal