diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index df2cbf7..4e79cb7 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -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 diff --git a/src/Language/Haskell/Brittany/Config.hs b/src/Language/Haskell/Brittany/Config.hs index 8426bfb..33bb981 100644 --- a/src/Language/Haskell/Brittany/Config.hs +++ b/src/Language/Haskell/Brittany/Config.hs @@ -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)) diff --git a/src/Language/Haskell/Brittany/Config/Types.hs b/src/Language/Haskell/Brittany/Config/Types.hs index 4178f58..b521f0a 100644 --- a/src/Language/Haskell/Brittany/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Config/Types.hs @@ -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 diff --git a/src/Language/Haskell/Brittany/Utils.hs b/src/Language/Haskell/Brittany/Utils.hs index a08cf80..8ff2e4e 100644 --- a/src/Language/Haskell/Brittany/Utils.hs +++ b/src/Language/Haskell/Brittany/Utils.hs @@ -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 } diff --git a/srcinc/prelude.inc b/srcinc/prelude.inc index bd42f2a..095aade 100644 --- a/srcinc/prelude.inc +++ b/srcinc/prelude.inc @@ -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 )