{-# LANGUAGE CPP #-}

-- | Operations for converting extensions types.
module HIndent.LanguageExtension.Conversion
  ( fromCabalExtension
  , uniqueExtensions
  , convertExtension
  , strToExt
  ) where

import qualified GHC.LanguageExtensions as GLP
import HIndent.LanguageExtension.Types
import qualified Language.Haskell.Extension as Cabal
import qualified Language.Haskell.GhclibParserEx.GHC.Driver.Session as GLP

-- | Converts from an `Extension` defined in the `Cabal` package to an
-- `Extension` defined in HIndent.
--
-- Note that this function returns `Nothing` if `UnknownExtension` is
-- passed or if an extension is not supported by GHC.
fromCabalExtension :: Cabal.Extension -> Maybe Extension
fromCabalExtension :: Extension -> Maybe Extension
fromCabalExtension (Cabal.EnableExtension KnownExtension
x) =
  Extension -> Extension
EnableExtension (Extension -> Extension) -> Maybe Extension -> Maybe Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KnownExtension -> Maybe Extension
convertExtension KnownExtension
x
fromCabalExtension (Cabal.DisableExtension KnownExtension
x) =
  Extension -> Extension
DisableExtension (Extension -> Extension) -> Maybe Extension -> Maybe Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KnownExtension -> Maybe Extension
convertExtension KnownExtension
x
fromCabalExtension Cabal.UnknownExtension {} = Maybe Extension
forall a. Maybe a
Nothing

-- | This function converts each value of the type 'Extension' defined in
-- 'HIndent.LanguageExtension.Types' in the list to the same value of the
-- type 'Extension' defined in the package 'ghc-lib-parser'.
--
-- If the extension has the 'No' suffix, the extension is removed from the
-- result. If both extensions having and not having the suffix exist in the
-- list, only the most backward one has the effect.
--
-- If converting an extension fails due to neither GHC nor 'ghc-lib-parser'
-- not supporting, or deprecation or removal, the extension is ignored.
uniqueExtensions :: [Extension] -> [GLP.Extension]
uniqueExtensions :: [Extension] -> [Extension]
uniqueExtensions [] = []
uniqueExtensions ((EnableExtension Extension
e):[Extension]
xs) = Extension
e Extension -> [Extension] -> [Extension]
forall a. a -> [a] -> [a]
: [Extension] -> [Extension]
uniqueExtensions [Extension]
xs
uniqueExtensions ((DisableExtension Extension
e):[Extension]
xs) =
  [Extension] -> [Extension]
uniqueExtensions ([Extension] -> [Extension]) -> [Extension] -> [Extension]
forall a b. (a -> b) -> a -> b
$ (Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
/= Extension -> Extension
EnableExtension Extension
e) [Extension]
xs

-- | This function converts a value of 'KnownExtension' defined in the
-- 'Cabal' package to the same value of 'Extension' defined in
-- 'ghc-lib-parser'.
--
-- This function returns a 'Just' value if it succeeds in converting.
-- Otherwise (e.g., 'ghc-lib-parser' does not the passed extension, or it
-- is deprecated or removed), it returns a 'Nothing'.
convertExtension :: Cabal.KnownExtension -> Maybe GLP.Extension
convertExtension :: KnownExtension -> Maybe Extension
convertExtension = String -> Maybe Extension
GLP.readExtension (String -> Maybe Extension)
-> (KnownExtension -> String) -> KnownExtension -> Maybe Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownExtension -> String
forall a. Show a => a -> String
show

-- | Converts the given string to an extension, or returns a 'Nothing' on
-- fail.
strToExt :: String -> Maybe Extension
strToExt :: String -> Maybe Extension
strToExt (Char
'N':Char
'o':String
s) = Extension -> Extension
DisableExtension (Extension -> Extension) -> Maybe Extension -> Maybe Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Extension
GLP.readExtension String
s
strToExt String
s = Extension -> Extension
EnableExtension (Extension -> Extension) -> Maybe Extension -> Maybe Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Extension
GLP.readExtension String
s