{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HIndent.LanguageExtension
( implicitExtensions
, extensionImplies
, collectLanguageExtensionsFromSource
, getExtensions
) where
import Data.Char
import Data.List
import Data.List.Split
import Data.Maybe
import qualified GHC.Driver.Session as GLP
import HIndent.LanguageExtension.Conversion
import HIndent.LanguageExtension.Types
import HIndent.Pragma
import Text.Regex.TDFA
implicitExtensions :: GLP.Language -> [Extension]
implicitExtensions :: Language -> [Extension]
implicitExtensions = (Extension -> Extension) -> [Extension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extension -> Extension
EnableExtension ([Extension] -> [Extension])
-> (Language -> [Extension]) -> Language -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Language -> [Extension]
GLP.languageExtensions (Maybe Language -> [Extension])
-> (Language -> Maybe Language) -> Language -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Maybe Language
forall a. a -> Maybe a
Just
extensionImplies :: Extension -> [Extension]
extensionImplies :: Extension -> [Extension]
extensionImplies (EnableExtension Extension
e) =
(Extension, Bool, Extension) -> Extension
forall {a}. (a, Bool, Extension) -> Extension
toExtension ((Extension, Bool, Extension) -> Extension)
-> [(Extension, Bool, Extension)] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Extension, Bool, Extension) -> Bool)
-> [(Extension, Bool, Extension)] -> [(Extension, Bool, Extension)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Extension
a, Bool
_, Extension
_) -> Extension
e Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
== Extension
a) [(Extension, Bool, Extension)]
GLP.impliedXFlags
where
toExtension :: (a, Bool, Extension) -> Extension
toExtension (a
_, Bool
True, Extension
e') = Extension -> Extension
EnableExtension Extension
e'
toExtension (a
_, Bool
False, Extension
e') = Extension -> Extension
DisableExtension Extension
e'
extensionImplies Extension
_ = []
collectLanguageExtensionsFromSource :: String -> [Extension]
collectLanguageExtensionsFromSource :: String -> [Extension]
collectLanguageExtensionsFromSource =
[Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
(++)
([Extension] -> [Extension] -> [Extension])
-> (String -> [Extension]) -> String -> [Extension] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Extension]
collectLanguageExtensionsSpecifiedViaLanguagePragma
(String -> [Extension] -> [Extension])
-> (String -> [Extension]) -> String -> [Extension]
forall a b. (String -> a -> b) -> (String -> a) -> String -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> [Extension]
collectLanguageExtensionsFromSourceViaOptionsPragma
getExtensions :: [String] -> [Extension]
getExtensions :: [String] -> [Extension]
getExtensions = (String -> [Extension] -> [Extension])
-> [Extension] -> [String] -> [Extension]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> [Extension] -> [Extension]
f []
where
f :: String -> [Extension] -> [Extension]
f String
"Haskell98" [Extension]
_ = []
f String
x [Extension]
a =
case String -> Maybe Extension
strToExt String
x of
Just x' :: Extension
x'@EnableExtension {} -> Extension
x' Extension -> [Extension] -> [Extension]
forall a. a -> [a] -> [a]
: Extension -> [Extension] -> [Extension]
forall a. Eq a => a -> [a] -> [a]
delete Extension
x' [Extension]
a
Just (DisableExtension Extension
x') -> Extension -> [Extension] -> [Extension]
forall a. Eq a => a -> [a] -> [a]
delete (Extension -> Extension
EnableExtension Extension
x') [Extension]
a
Maybe Extension
_ -> String -> [Extension]
forall a. HasCallStack => String -> a
error (String -> [Extension]) -> String -> [Extension]
forall a b. (a -> b) -> a -> b
$ String
"Unknown extension: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
collectLanguageExtensionsSpecifiedViaLanguagePragma :: String -> [Extension]
collectLanguageExtensionsSpecifiedViaLanguagePragma :: String -> [Extension]
collectLanguageExtensionsSpecifiedViaLanguagePragma =
(String -> Maybe Extension) -> [String] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe Extension
strToExt (String -> Maybe Extension)
-> (String -> String) -> String -> Maybe Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripSpaces)
([String] -> [Extension])
-> (String -> [String]) -> String -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
",")
([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> b
snd
([(String, String)] -> [String])
-> (String -> [(String, String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"LANGUAGE") (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst)
([(String, String)] -> [(String, String)])
-> (String -> [(String, String)]) -> String -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)]
extractPragmasFromCode
collectLanguageExtensionsFromSourceViaOptionsPragma :: String -> [Extension]
collectLanguageExtensionsFromSourceViaOptionsPragma :: String -> [Extension]
collectLanguageExtensionsFromSourceViaOptionsPragma =
(String -> Maybe Extension) -> [String] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe Extension
strToExt (String -> Maybe Extension)
-> (String -> String) -> String -> Maybe Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripSpaces)
([String] -> [Extension])
-> (String -> [String]) -> String -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
extractLanguageExtensionsFromOptions
([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> b
snd
([(String, String)] -> [String])
-> (String -> [(String, String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"OPTIONS", String
"OPTIONS_GHC"]) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst)
([(String, String)] -> [(String, String)])
-> (String -> [(String, String)]) -> String -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)]
extractPragmasFromCode
extractLanguageExtensionsFromOptions :: String -> [String]
String
options =
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
String -> String
trimXOption
(AllTextMatches [] String -> [String]
forall (f :: * -> *) b. AllTextMatches f b -> f b
getAllTextMatches (String
options String -> String -> AllTextMatches [] String
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"-X[^,[:space:]]+") :: [String])
where
trimXOption :: String -> String
trimXOption (Char
'-':Char
'X':String
xs) = String
xs
trimXOption String
_ = String -> String
forall a. HasCallStack => String -> a
error String
"Unreachable: the option must have the `-X` prefix."
stripSpaces :: String -> String
stripSpaces :: String -> String
stripSpaces = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace