Fix commandline flag parsing (again, oops)

pull/3/head
Lennart Spitzner 2016-08-12 20:57:37 +02:00
parent 59cee6fb0e
commit b58a8b0146
5 changed files with 55 additions and 37 deletions

View File

@ -219,7 +219,7 @@ mainCmdParser = do
then trace "----"
else id
readConfigs :: ConfigF Maybe -> [System.IO.FilePath] -> MaybeT IO Config
readConfigs :: ConfigF Option -> [System.IO.FilePath] -> MaybeT IO Config
readConfigs cmdlineConfig configPaths = do
let defLocalConfigPath = "brittany.yaml"
userBritPath <- liftIO $ Directory.getAppUserDataDirectory "brittany"
@ -234,4 +234,4 @@ readConfigs cmdlineConfig configPaths = do
paths -> foldl (\prev p -> prev >>= readMergePersConfig p False)
(return cmdlineConfig)
paths
return $ cZip fromMaybeIdentity staticDefaultConfig merged
return $ cZip fromOptionIdentity staticDefaultConfig merged

View File

@ -70,7 +70,7 @@ import Data.Coerce ( Coercible, coerce )
configParser :: CmdParser Identity out (ConfigF Maybe)
configParser :: CmdParser Identity out (ConfigF Option)
configParser = do
-- TODO: why does the default not trigger; ind never should be []!!
ind <- addFlagReadParam "" ["indent"] "AMOUNT"
@ -112,18 +112,18 @@ configParser = do
, _dconf_dump_bridoc_final = wrapLast $ falseToNothing dumpBriDocFinal
}
, _conf_layout = LayoutConfig
{ _lconfig_cols = listLastMaybe cols
, _lconfig_indentPolicy = Nothing
, _lconfig_indentAmount = listLastMaybe ind
, _lconfig_indentWhereSpecial = Nothing -- falseToNothing _
, _lconfig_indentListSpecial = Nothing -- falseToNothing _
, _lconfig_importColumn = listLastMaybe importCol
, _lconfig_altChooser = Nothing
{ _lconfig_cols = optionConcat cols
, _lconfig_indentPolicy = mempty
, _lconfig_indentAmount = optionConcat ind
, _lconfig_indentWhereSpecial = mempty -- falseToNothing _
, _lconfig_indentListSpecial = mempty -- falseToNothing _
, _lconfig_importColumn = optionConcat importCol
, _lconfig_altChooser = mempty
}
, _conf_errorHandling = ErrorHandlingConfig
{ _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors
, _econf_Werror = wrapLast $ falseToNothing wError
, _econf_CPPMode = Nothing
, _econf_CPPMode = mempty
}
, _conf_forward = ForwardOptions
{ _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs
@ -131,9 +131,12 @@ configParser = do
]
}
}
where falseToNothing = Bool.bool Nothing (Just True)
where falseToNothing = Option . Bool.bool Nothing (Just True)
wrapLast :: Option a -> Option (Semigroup.Last a)
wrapLast = fmap Semigroup.Last
listLastMaybe = listToMaybe . reverse
optionConcat
:: (Semigroup.Semigroup (f a), Applicative f) => [a] -> Option (f a)
optionConcat = mconcat . fmap (pure . pure)
-- configParser :: Parser Config
-- configParser = Config
@ -157,7 +160,7 @@ configParser = do
-- }
readMergePersConfig
:: System.IO.FilePath -> Bool -> ConfigF Maybe -> MaybeT IO (ConfigF Maybe)
:: System.IO.FilePath -> Bool -> ConfigF Option -> MaybeT IO (ConfigF Option)
readMergePersConfig path shouldCreate conf = do
exists <- liftIO $ System.Directory.doesFileExist path
if
@ -175,7 +178,7 @@ readMergePersConfig path shouldCreate conf = do
| shouldCreate -> do
liftIO $ ByteString.writeFile path
$ Data.Yaml.encode
$ cMap (Just . runIdentity) staticDefaultConfig
$ cMap (Option . Just . runIdentity) staticDefaultConfig
return $ conf
| otherwise -> do
return conf
@ -183,4 +186,4 @@ readMergePersConfig path shouldCreate conf = do
showConfigYaml :: Config -> String
showConfigYaml = Data.ByteString.Char8.unpack
. Data.Yaml.encode
. cMap (\(Identity x) -> Just x)
. cMap (\(Identity x) -> Option (Just x))

View File

@ -21,7 +21,7 @@ import Data.Coerce ( Coercible, coerce )
import Data.Semigroup.Generic
import Data.Semigroup ( Last )
import Data.Semigroup ( Last, Option )
@ -83,11 +83,11 @@ deriving instance Show (ErrorHandlingConfigF Identity)
deriving instance Show (ForwardOptionsF Identity)
deriving instance Show (ConfigF Identity)
deriving instance Show (DebugConfigF Maybe)
deriving instance Show (LayoutConfigF Maybe)
deriving instance Show (ErrorHandlingConfigF Maybe)
deriving instance Show (ForwardOptionsF Maybe)
deriving instance Show (ConfigF Maybe)
deriving instance Show (DebugConfigF Option)
deriving instance Show (LayoutConfigF Option)
deriving instance Show (ErrorHandlingConfigF Option)
deriving instance Show (ForwardOptionsF Option)
deriving instance Show (ConfigF Option)
deriving instance Data (DebugConfigF Identity)
deriving instance Data (LayoutConfigF Identity)
@ -95,15 +95,15 @@ deriving instance Data (ErrorHandlingConfigF Identity)
deriving instance Data (ForwardOptionsF Identity)
deriving instance Data (ConfigF Identity)
instance Semigroup.Semigroup (DebugConfigF Maybe) where
instance Semigroup.Semigroup (DebugConfigF Option) where
(<>) = gmappend
instance Semigroup.Semigroup (LayoutConfigF Maybe) where
instance Semigroup.Semigroup (LayoutConfigF Option) where
(<>) = gmappend
instance Semigroup.Semigroup (ErrorHandlingConfigF Maybe) where
instance Semigroup.Semigroup (ErrorHandlingConfigF Option) where
(<>) = gmappend
instance Semigroup.Semigroup (ForwardOptionsF Maybe) where
instance Semigroup.Semigroup (ForwardOptionsF Option) where
(<>) = gmappend
instance Semigroup.Semigroup (ConfigF Maybe) where
instance Semigroup.Semigroup (ConfigF Option) where
(<>) = gmappend
type Config = ConfigF Identity
@ -116,9 +116,17 @@ instance FromJSON a => FromJSON (Semigroup.Last a) where
{-# INLINE parseJSON #-}
instance ToJSON a => ToJSON (Semigroup.Last a) where
toJSON (Semigroup.Last x) = toJSON x
{-# INLINE toJSON #-}
instance FromJSON (DebugConfigF Maybe)
instance ToJSON (DebugConfigF Maybe)
instance FromJSON a => FromJSON (Option a) where
parseJSON obj = Option <$> parseJSON obj
{-# INLINE parseJSON #-}
instance ToJSON a => ToJSON (Option a) where
toJSON (Option x) = toJSON x
{-# INLINE toJSON #-}
instance FromJSON (DebugConfigF Option)
instance ToJSON (DebugConfigF Option)
instance FromJSON IndentPolicy
instance ToJSON IndentPolicy
@ -127,17 +135,17 @@ instance ToJSON AltChooser
instance FromJSON CPPMode
instance ToJSON CPPMode
instance FromJSON (LayoutConfigF Maybe)
instance ToJSON (LayoutConfigF Maybe)
instance FromJSON (LayoutConfigF Option)
instance ToJSON (LayoutConfigF Option)
instance FromJSON (ErrorHandlingConfigF Maybe)
instance ToJSON (ErrorHandlingConfigF Maybe)
instance FromJSON (ErrorHandlingConfigF Option)
instance ToJSON (ErrorHandlingConfigF Option)
instance FromJSON (ForwardOptionsF Maybe)
instance ToJSON (ForwardOptionsF Maybe)
instance FromJSON (ForwardOptionsF Option)
instance ToJSON (ForwardOptionsF Option)
instance FromJSON (ConfigF Maybe)
instance ToJSON (ConfigF Maybe)
instance FromJSON (ConfigF Option)
instance ToJSON (ConfigF Option)
-- instance Monoid DebugConfig where
-- mempty = DebugConfig Nothing Nothing

View File

@ -6,6 +6,7 @@ module Language.Haskell.Brittany.Utils
, (%=+)
, parDoc
, fromMaybeIdentity
, fromOptionIdentity
, traceIfDumpConf
, mModify
, customLayouterF
@ -78,6 +79,11 @@ fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
fromMaybeIdentity x y = Data.Coerce.coerce
$ fromMaybe (Data.Coerce.coerce x) y
fromOptionIdentity :: Identity a -> Option a -> Identity a
fromOptionIdentity x y = Data.Coerce.coerce
$ fromMaybe (Data.Coerce.coerce x)
$ getOption y
-- maximum monoid over N+0
-- or more than N, because Num is allowed.
newtype Max a = Max { getMax :: a }

View File

@ -445,6 +445,7 @@ import Data.Char ( Char )
import Data.Either ( Either(..) )
import Data.IORef ( IORef )
import Data.Maybe ( Maybe(..) )
import Data.Semigroup ( Option(..) )
import Data.Monoid ( Endo(..), All(..), Any(..), Sum(..), Product(..), Alt(..), )
import Data.Ord ( Ordering(..), Down(..) )
import Data.Ratio ( Ratio, Rational )