-- |
-- Description: handling of command line options

module Smuggler2.Options
  ( Options (..),
    parseCommandLineOptions,
    ImportAction (..),
    ExportAction (..),
  )
where

import Data.Char (toLower)
import Data.List (foldl')
import Plugins (CommandLineOption)

-- | Ways of performing import processing
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)

-- | Ways of performing emport processing
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)

-- | Internal representation of the plugin's command line options
data Options = Options
  { Options -> ImportAction
importAction :: ImportAction,
    Options -> ExportAction
exportAction :: ExportAction,
    Options -> Maybe String
newExtension :: Maybe String
  }
  deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

-- | The default is to retain instance-only imports (eg, Data.List () )
-- and add explict exports only if they are not already present
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = ImportAction -> ExportAction -> Maybe String -> Options
Options ImportAction
PreserveInstanceImports ExportAction
AddExplicitExports Maybe String
forall a. Maybe a
Nothing

-- | Simple command line option parser.  Last occurrence wins.
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
_ -> Options
opts {newExtension :: Maybe String
newExtension = String -> Maybe String
forall a. a -> Maybe a
Just String
clo}