{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
module Smuggler2.Options
( Options (..),
parseCommandLineOptions,
ImportAction (..),
ExportAction (..),
)
where
import Data.Char ( isSpace, toLower )
import Data.List ( foldl' )
import Data.List.Split ( splitOn )
import GHC ( mkModuleName, ModuleName )
import Outputable ( Outputable )
import Plugins ( CommandLineOption )
data ImportAction = NoImportProcessing | PreserveInstanceImports | MinimiseImports
deriving (ImportAction -> ImportAction -> Bool
(ImportAction -> ImportAction -> Bool)
-> (ImportAction -> ImportAction -> Bool) -> Eq ImportAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportAction -> ImportAction -> Bool
$c/= :: ImportAction -> ImportAction -> Bool
== :: ImportAction -> ImportAction -> Bool
$c== :: ImportAction -> ImportAction -> Bool
Eq, Int -> ImportAction -> ShowS
[ImportAction] -> ShowS
ImportAction -> String
(Int -> ImportAction -> ShowS)
-> (ImportAction -> String)
-> ([ImportAction] -> ShowS)
-> Show ImportAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportAction] -> ShowS
$cshowList :: [ImportAction] -> ShowS
show :: ImportAction -> String
$cshow :: ImportAction -> String
showsPrec :: Int -> ImportAction -> ShowS
$cshowsPrec :: Int -> ImportAction -> ShowS
Show)
data ExportAction = NoExportProcessing | AddExplicitExports | ReplaceExports
deriving (ExportAction -> ExportAction -> Bool
(ExportAction -> ExportAction -> Bool)
-> (ExportAction -> ExportAction -> Bool) -> Eq ExportAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportAction -> ExportAction -> Bool
$c/= :: ExportAction -> ExportAction -> Bool
== :: ExportAction -> ExportAction -> Bool
$c== :: ExportAction -> ExportAction -> Bool
Eq, Int -> ExportAction -> ShowS
[ExportAction] -> ShowS
ExportAction -> String
(Int -> ExportAction -> ShowS)
-> (ExportAction -> String)
-> ([ExportAction] -> ShowS)
-> Show ExportAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportAction] -> ShowS
$cshowList :: [ExportAction] -> ShowS
show :: ExportAction -> String
$cshow :: ExportAction -> String
showsPrec :: Int -> ExportAction -> ShowS
$cshowsPrec :: Int -> ExportAction -> ShowS
Show)
data Options = Options
{ Options -> ImportAction
importAction :: ImportAction,
Options -> ExportAction
exportAction :: ExportAction,
Options -> Maybe String
newExtension :: Maybe String,
Options -> [ModuleName]
leaveOpenImports :: [ModuleName],
Options -> [ModuleName]
makeOpenImports :: [ModuleName]
}
deriving (Rational -> Options -> SDoc
Options -> SDoc
(Options -> SDoc)
-> (Rational -> Options -> SDoc) -> Outputable Options
forall a. (a -> SDoc) -> (Rational -> a -> SDoc) -> Outputable a
pprPrec :: Rational -> Options -> SDoc
$cpprPrec :: Rational -> Options -> SDoc
ppr :: Options -> SDoc
$cppr :: Options -> SDoc
Outputable)
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = ImportAction
-> ExportAction
-> Maybe String
-> [ModuleName]
-> [ModuleName]
-> Options
Options ImportAction
PreserveInstanceImports ExportAction
AddExplicitExports Maybe String
forall a. Maybe a
Nothing [] []
parseCommandLineOptions :: [CommandLineOption] -> Options
parseCommandLineOptions :: [String] -> Options
parseCommandLineOptions = (Options -> String -> Options) -> Options -> [String] -> Options
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Options -> String -> Options
parseCommandLineOption Options
defaultOptions
where
parseCommandLineOption :: Options -> CommandLineOption -> Options
parseCommandLineOption :: Options -> String -> Options
parseCommandLineOption Options
opts String
clo = case Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
clo of
String
"noimportprocessing" -> Options
opts {importAction :: ImportAction
importAction = ImportAction
NoImportProcessing}
String
"preserveinstanceimports" -> Options
opts {importAction :: ImportAction
importAction = ImportAction
PreserveInstanceImports}
String
"minimiseimports" -> Options
opts {importAction :: ImportAction
importAction = ImportAction
MinimiseImports}
String
"noexportprocessing" -> Options
opts {exportAction :: ExportAction
exportAction = ExportAction
NoExportProcessing}
String
"addexplicitexports" -> Options
opts {exportAction :: ExportAction
exportAction = ExportAction
AddExplicitExports}
String
"replaceexports" -> Options
opts {exportAction :: ExportAction
exportAction = ExportAction
ReplaceExports}
String
_
| Just String
modulenames <- String -> String -> Maybe String
stripPrefixCI String
"leaveopenimports:" String
clo ->
Options
opts {leaveOpenImports :: [ModuleName]
leaveOpenImports = String -> [ModuleName]
parseModuleNames String
modulenames}
| Just String
modulenames <- String -> String -> Maybe String
stripPrefixCI String
"makeopenimports:" String
clo ->
Options
opts {makeOpenImports :: [ModuleName]
makeOpenImports = String -> [ModuleName]
parseModuleNames String
modulenames}
| Bool
otherwise -> Options
opts {newExtension :: Maybe String
newExtension = String -> Maybe String
forall a. a -> Maybe a
Just String
clo}
parseModuleNames :: String -> [ModuleName]
parseModuleNames :: String -> [ModuleName]
parseModuleNames String
arg = String -> ModuleName
mkModuleName (String -> ModuleName) -> [String] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"," ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
arg)
stripPrefixCI :: String -> String -> Maybe String
stripPrefixCI :: String -> String -> Maybe String
stripPrefixCI [] String
ys = String -> Maybe String
forall a. a -> Maybe a
Just String
ys
stripPrefixCI (Char
x : String
xs) (Char
y : String
ys)
| Char -> Char
toLower Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
y = String -> String -> Maybe String
stripPrefixCI String
xs String
ys
stripPrefixCI String
_ String
_ = Maybe String
forall a. Maybe a
Nothing