coformat 0.2.1.0 → 0.3.0.0

raw patch · 25 files changed

+820/−741 lines, 25 filesdep +commandPVP ok

version bump matches the API change (PVP)

Dependencies added: command

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• app/Main.hs +9/−3
• coformat.cabal +16/−11
• src/Clang/Coformat/Formatter.hs +0/−19
• src/Clang/Coformat/Optimization.hs +0/−164
• src/Clang/Coformat/Pipeline.hs +0/−148
• src/Clang/Coformat/Score.hs +0/−70
• src/Clang/Coformat/StyOpts.hs +0/−44
• src/Clang/Coformat/Util.hs +0/−78
• src/Clang/Coformat/Variables.hs +0/−94
• src/Clang/Format/Descr.hs +0/−41
• src/Clang/Format/Descr/Operations.hs +0/−61
• src/Clang/Format/DescrParser.hs +2/−6
• src/Clang/Format/Formatter.hs +72/−0
• src/Clang/Format/StyOpts.hs +45/−0
• src/Clang/Format/YamlConversions.hs +2/−2
• src/Language/Coformat/Descr.hs +41/−0
• src/Language/Coformat/Descr/Operations.hs +61/−0
• src/Language/Coformat/Formatter.hs +64/−0
• src/Language/Coformat/Formatter/Failure.hs +23/−0
• src/Language/Coformat/Optimization.hs +159/−0
• src/Language/Coformat/Pipeline.hs +109/−0
• src/Language/Coformat/Score.hs +70/−0
• src/Language/Coformat/Util.hs +48/−0
• src/Language/Coformat/Variables.hs +94/−0

@@ -1,5 +1,10 @@ # Changelog for coformat +## v0.3.0.0++* A fairly major refactoring: isolated the description of the formatters.+* Change the casing of flags to be more in line with the common lisp-style.+ ## v0.2.1.0  * Allow the user to force-set formatter options.

@@ -17,7 +17,8 @@ import System.IO(IOMode(..), Handle, stderr, withFile) import System.Log.FastLogger -import Clang.Coformat.Pipeline+import Clang.Format.Formatter+import Language.Coformat.Pipeline  data Options w = Options   { parallelism :: w ::: Maybe Natural <?> "Max parallel threads of heavy-duty computations (defaults to NCPUs - 1)"@@ -29,7 +30,8 @@   , output :: w ::: FilePath <?> "Where to save the resulting configuration file"   } deriving (Generic) -instance ParseRecord (Options Wrapped)+instance ParseRecord (Options Wrapped) where+  parseRecord = parseRecordWithModifiers lispCaseModifiers  logOutput :: Maybe Handle           -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()@@ -53,7 +55,11 @@    res <- withDebugLog $ \maybeLogHandle ->          withTaskGroup tgSize $ \taskGroup ->-         (`runLoggingT` logOutput maybeLogHandle) $ runExceptT $ runOptPipeline PipelineOpts { forceStrs = forceOption, .. }+         (`runLoggingT` logOutput maybeLogHandle) $ runExceptT $ runOptPipeline PipelineOpts+                                                                                { forceStrs = forceOption+                                                                                , formatter = clangFormatter+                                                                                , ..+                                                                                }   case res of        Left err -> putStrLn err        Right bs -> BS.writeFile output bs

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ea70ef65978e2e5237ba446709fed08a5dcdef26609680601b4b7a02afdbdc95+-- hash: 842fc70286283a152b2bed20670e1262702c1b7efa574a215ebab64b09049761  name:           coformat-version:        0.2.1.0+version:        0.3.0.0 synopsis:       Generate clang-format config based on some existing code base description:    Please see the README on GitHub at <https://github.com/0xd34df00d/coformat#readme> category:       Language@@ -29,17 +29,19 @@  library   exposed-modules:-      Clang.Coformat.Formatter-      Clang.Coformat.Optimization-      Clang.Coformat.Pipeline-      Clang.Coformat.Score-      Clang.Coformat.StyOpts-      Clang.Coformat.Util-      Clang.Coformat.Variables-      Clang.Format.Descr-      Clang.Format.Descr.Operations       Clang.Format.DescrParser+      Clang.Format.Formatter+      Clang.Format.StyOpts       Clang.Format.YamlConversions+      Language.Coformat.Descr+      Language.Coformat.Descr.Operations+      Language.Coformat.Formatter+      Language.Coformat.Formatter.Failure+      Language.Coformat.Optimization+      Language.Coformat.Pipeline+      Language.Coformat.Score+      Language.Coformat.Util+      Language.Coformat.Variables   other-modules:       Paths_coformat   hs-source-dirs:@@ -52,6 +54,7 @@     , base >=4.7 && <5     , bytestring     , can-i-haz+    , command     , command-qq     , containers     , dom-selector@@ -89,6 +92,7 @@     , bytestring     , can-i-haz     , coformat+    , command     , command-qq     , containers     , dom-selector@@ -127,6 +131,7 @@     , bytestring     , can-i-haz     , coformat+    , command     , command-qq     , containers     , dom-selector

@@ -1,19 +0,0 @@-{-# LANGUAGE DataKinds #-}--module Clang.Coformat.Formatter where--import qualified Data.ByteString.Char8 as BS-import qualified Data.Text as T-import Control.Monad.IO.Class--import Clang.Format.Descr--data FormatterInfo = FormatterInfo-  { executableName :: String-  , knownOptions :: [ConfigItemT 'Supported]-  , baseStyles :: [T.Text]-  } deriving (Show)--class Formatter fmt where-  formatterInfo :: proxy fmt -> FormatterInfo-  formatFile :: MonadIO m => proxy fmt -> T.Text -> [ConfigItemT 'Value] -> FilePath -> m BS.ByteString

@@ -1,164 +0,0 @@-{-# LANGUAGE GADTs, DataKinds, TypeApplications, RankNTypes, ScopedTypeVariables, ConstraintKinds #-}-{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}-{-# LANGUAGE QuasiQuotes, RecordWildCards, TupleSections, LambdaCase #-}--module Clang.Coformat.Optimization where--import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T-import qualified Data.Text.Lazy.Encoding as TL-import Control.Concurrent.Async.Pool-import Control.Lens-import Control.Monad.Except.CoHas-import Control.Monad.Extra-import Control.Monad.Logger-import Control.Monad.Reader.Has hiding(update)-import Control.Monad.State.Strict-import Data.Foldable-import Data.List-import Data.Ord-import Data.Proxy-import Data.String.Interpolate.IsString-import Numeric.Natural-import System.Command.QQ--import Clang.Coformat.Score-import Clang.Coformat.StyOpts-import Clang.Coformat.Util-import Clang.Coformat.Variables-import Clang.Format.Descr--data FmtEnv = FmtEnv-  { baseStyle :: T.Text-  , preparedFiles :: [PreparedFile]-  , constantOpts :: [ConfigItemT 'Value]-  }--data OptEnv = OptEnv-  { categoricalVariables :: [IxedCategoricalVariable]-  , integralVariables :: [IxedIntegralVariable]-  , maxSubsetSize :: Natural-  }--runClangFormat :: (MonadError err m, CoHas UnexpectedFailure err, CoHas ExpectedFailure err, MonadIO m, MonadLogger m)-               => PreparedFile -> String -> BSL.ByteString -> m Score-runClangFormat prepared logStr formattedSty = do-  stdout <- checked [sh|clang-format --style='#{unpackedSty}' #{path}|]-  let dist = calcScore prepared $ BSL.toStrict $ TL.encodeUtf8 stdout-  logDebugN [i|#{logStr}: #{dist}|]-  pure dist-  where-    path = filename prepared-    unpackedSty = BSL.unpack formattedSty--type OptMonad err r m = (MonadLoggerIO m, MonadError err m, CoHas UnexpectedFailure err, MonadReader r m, Has FmtEnv r)--runClangFormatFiles :: (OptMonad err r m, CoHas ExpectedFailure err)-                    => [ConfigItemT 'Value] -> String -> m Score-runClangFormatFiles varOpts logStr = do-  FmtEnv { .. } <- ask-  let sty = StyOpts { basedOnStyle = baseStyle, additionalOpts = constantOpts <> varOpts }-  let formattedSty = formatStyArg sty-  fmap mconcat $ forM preparedFiles $ \prepared -> runClangFormat prepared [i|#{logStr} at #{filename prepared}|] formattedSty--chooseBaseStyle :: (MonadError String m, MonadLoggerIO m) => [T.Text] -> [ConfigItemT 'Value] -> [PreparedFile] -> m (T.Text, Score)-chooseBaseStyle baseStyles predefinedOpts files = do-  sty2dists <- forConcurrently' ((,) <$> baseStyles <*> files) $ \(sty, file) -> do-    let formattedArg = formatStyArg StyOpts { basedOnStyle = sty, additionalOpts = predefinedOpts }-    convert (show @(Either ExpectedFailure UnexpectedFailure)) $ (sty,) <$> runClangFormat file [i|Initial guess for #{sty} at #{filename file}|] formattedArg-  let accumulated = HM.toList $ HM.fromListWith (<>) sty2dists-  forM_ accumulated $ \(sty, acc) -> logInfoN [i|Initial accumulated guess for #{sty}: #{acc}|]-  pure $ minimumBy (comparing snd) accumulated--variateAt :: forall a. (Variate a, Foldable (VariateResult a))-          => Proxy a -> Int -> [ConfigItemT 'Value] -> [[ConfigItemT 'Value]]-variateAt _ idx opts = [ update idx (updater v') opts | v' <- toList variated ]-  where-    thePrism :: Prism' (ConfigTypeT 'Value) a-    thePrism = varPrism-    variated = variate $ value (opts !! idx) ^?! thePrism-    updater v cfg = cfg { value = value cfg & thePrism .~ v }--data OptState = OptState-  { currentOpts :: [ConfigItemT 'Value]-  , currentScore :: Score-  } deriving (Show)--initOptState :: [ConfigItemT 'Value] -> Score -> OptState-initOptState currentOpts currentScore = OptState { .. }--dropExpectedFailures :: OptMonad err r m-                     => (forall err' r' m'. (OptMonad err' r' m', CoHas ExpectedFailure err') => m' Score)-                     -> m Score-dropExpectedFailures act = do-  res <- runExceptT act-  case res of-       Left (UnexpectedFailure failure) -> throwError failure-       Left (ExpectedFailure failure) -> do-         logErrorN [i|Unable to run the formatter: #{show failure}|]-         pure maxBound-       Right sc -> pure sc--variateSubset :: [SomeIxedVariable] -> [ConfigItemT 'Value] -> [[ConfigItemT 'Value]]-variateSubset [] opts = [opts]-variateSubset (SomeIxedVariable (IxedVariable (MkDV (_ :: a)) idx) : rest) opts = concatMap (variateSubset rest) $ variateAt @a Proxy idx opts--showVariated :: [SomeIxedVariable] -> [ConfigItemT 'Value] -> String-showVariated vars opts = intercalate ", " [showVar var | var <- vars]-  where-    showVar (SomeIxedVariable (IxedVariable _ idx)) = [i|#{name $ opts !! idx} -> #{value $ opts !! idx}|]--chooseBestSubset :: (OptMonad err r m, Has OptState r, Has TaskGroup r)-                 => Natural -> [SomeIxedVariable] -> m (Maybe ([ConfigItemT 'Value], Score))-chooseBestSubset subsetSize ixedVariables = do-  OptState { .. } <- ask-  partialResults <- forConcurrentlyPooled (subsetsN subsetSize ixedVariables) $ \someVarsSubset -> do-    opt2scores <- forM (variateSubset someVarsSubset currentOpts) $ \opts' ->-      fmap (opts',) $ dropExpectedFailures $ runClangFormatFiles opts' $ showVariated someVarsSubset opts'-    let (bestOpts, bestScore) = minimumBy (comparing snd) opt2scores-    when (bestScore < currentScore) $-      logInfoN [i|Total dist for #{showVariated someVarsSubset bestOpts}: #{currentScore} -> #{bestScore}|]-    pure (bestOpts, bestScore, someVarsSubset)-  let (bestOpts, bestScore, bestVarsSubset) = minimumBy (comparing (^. _2)) partialResults-  if bestScore < currentScore-    then do-      logInfoN [i|Choosing #{showVariated bestVarsSubset bestOpts}|]-      pure $ Just (bestOpts, bestScore)-    else pure Nothing--stepGDGeneric' :: (OptMonad err r m, Has TaskGroup r, Has OptEnv r, MonadState OptState m)-               => Natural -> [OptEnv -> [SomeIxedVariable]] -> m ()-stepGDGeneric' subsetSize varGetters = do-  current <- get-  fmtEnv@FmtEnv { .. } <- ask-  optEnv <- ask-  tg :: TaskGroup <- ask-  runReaderT (chooseBestSubset subsetSize $ concatMap ($ optEnv) varGetters) (current, fmtEnv, tg) >>=-    \case Nothing -> pure ()-          Just (opts', score') -> do-            logInfoN [i|Total score after optimization on all files: #{score'}|]-            put OptState { currentOpts = opts', currentScore = score' }--stepGDGeneric :: (OptMonad err r m, Has TaskGroup r, Has OptEnv r, MonadState OptState m)-              => Natural -> [OptEnv -> [SomeIxedVariable]] -> m ()-stepGDGeneric subsetSize varGetters = whenM ((> mempty) <$> gets currentScore) $ stepGDGeneric' subsetSize varGetters--fixGD :: (OptMonad err r m, Has TaskGroup r, Has OptEnv r, MonadState OptState m, err ~ UnexpectedFailure)-      => Maybe Int -> Natural -> m ()-fixGD (Just 0) _ = pure ()-fixGD counter curSubsetSize = do-  maxSubsetSize' <- asks maxSubsetSize-  if curSubsetSize > maxSubsetSize'-    then logInfoN [i|Done optimizing|]-    else do-      startScore <- gets currentScore-      stepGDGeneric curSubsetSize [asSome . categoricalVariables, asSome . integralVariables]-      endScore <- gets currentScore-      logInfoN [i|Full optimization step done, went from #{startScore} to #{endScore}|]-      if startScore /= endScore-        then fixGD (subtract 1 <$> counter) 1-        else do-          logInfoN [i|Done optimizing with subset size #{curSubsetSize}, stopped at score #{endScore}|]-          fixGD (subtract 1 <$> counter) (curSubsetSize + 1)

@@ -1,148 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DataKinds, GADTs #-}-{-# LANGUAGE TypeApplications, OverloadedStrings, RecordWildCards, QuasiQuotes #-}--module Clang.Coformat.Pipeline-( runOptPipeline-, PipelineOpts(..)-) where--import qualified Control.Monad.Except.CoHas as EC-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T-import qualified Data.Text.Lazy.Encoding as TL-import Control.Concurrent.Async.Pool-import Control.Lens hiding (Wrapped, Unwrapped)-import Control.Monad.Except-import Control.Monad.Logger-import Control.Monad.Reader-import Control.Monad.State.Strict-import Data.Aeson.Lens-import Data.Bifunctor-import Data.Foldable-import Data.List.NonEmpty(NonEmpty)-import Data.Maybe-import Data.String.Interpolate.IsString-import Data.Traversable-import Numeric.Natural-import System.Command.QQ--import Clang.Coformat.Optimization-import Clang.Coformat.Score-import Clang.Coformat.StyOpts-import Clang.Coformat.Util-import Clang.Coformat.Variables-import Clang.Format.Descr-import Clang.Format.Descr.Operations-import Clang.Format.DescrParser-import Clang.Format.YamlConversions--liftEither' :: (MonadError String m, Show e) => String -> Either e a -> m a-liftEither' context = liftEither . first ((context <>) . show)--parseOptsDescription :: (MonadError String m, MonadIO m) => FilePath -> m ([T.Text], [ConfigItemT 'Supported])-parseOptsDescription path = do-  parseResult <- liftIO $ parseFile path-  supportedOptions <- filterParsedItems <$> liftEither' "Unable to parse the file: " parseResult-  baseStyles <- case find ((== bosKey) . name) supportedOptions of-                     Nothing -> throwError "No `BasedOnStyle` option"-                     Just stys -> pure stys-  let varyingOptions = filter ((/= bosKey) . name) supportedOptions-  case value baseStyles of-       CTEnum { .. } -> pure (variants, varyingOptions)-       _ -> throwError [i|Unknown type for the `BaseStyles` option: #{value baseStyles}|]-  where-    bosKey = ["BasedOnStyle"]--hardcodedOpts :: [ConfigItemT 'Value]-hardcodedOpts = [ ConfigItem { name = ["Language"], value = CTEnum ["Cpp"] "Cpp" }-                , ConfigItem { name = ["BreakBeforeBraces"], value = CTEnum ["Custom"] "Custom" }-                , ConfigItem { name = ["DisableFormat"], value = CTBool False }-                , ConfigItem { name = ["SortIncludes"], value = CTBool False }-                ]--data InitializeOptionsResult = InitializeOptionsResult-  { baseStyle :: T.Text-  , baseScore :: Score-  , baseOptions :: [ConfigItemT 'Value]-  , filledOptions :: [ConfigItemT 'Value]-  , userForcedOpts :: [ConfigItemT 'Value]-  }--initializeOptions :: (MonadError String m, MonadLoggerIO m)-                  => [PreparedFile] -> Maybe FilePath -> [String] -> m InitializeOptionsResult-initializeOptions preparedFiles maybeResumePath forceStrs = do-  (baseStyles, allOptions) <- parseOptsDescription "data/ClangFormatStyleOptions-9.html"-  let varyingOptions = filter (not . (`elem` hardcodedOptsNames) . name) allOptions-  userForcedOpts <- parseUserOpts forceStrs allOptions--  maybeResumeObj <- for maybeResumePath $ liftIO . BS.readFile-                                      >=> convert (show @FillError) . preprocessYaml PartialConfig-  maybeResumeOptions <- for maybeResumeObj $ convert (show @FillError) . collectConfigItems varyingOptions--  let allFixedOpts = hardcodedOpts <> userForcedOpts--  (baseStyle, baseScore) <--      case maybeResumeObj of-           Nothing -> chooseBaseStyle baseStyles allFixedOpts preparedFiles-           Just resumeObj -> do-              baseStyle <- EC.liftMaybe ("Unable to find `BasedOnStyle` key in the resume file" :: String)-                        $ HM.lookup "BasedOnStyle" resumeObj ^? _Just . _String-              constantOpts <- convert (show @FillError) $ collectConfigItems varyingOptions resumeObj-              score <- convert (show @Failure) $ flip runReaderT FmtEnv { .. } $ runClangFormatFiles allFixedOpts [i|Calculating the score of the resumed-from style|]-              pure (baseStyle, score)--  logInfoN [i|Using initial style: #{baseStyle} with score of #{baseScore}|]-  let formattedBaseSty = BSL.unpack $ formatStyArg $ StyOpts { basedOnStyle = baseStyle, additionalOpts = allFixedOpts }-  stdout <- convert (show @Failure) $ checked [sh|clang-format --style='#{formattedBaseSty}' --dump-config|]-  baseOptions <- convert (show @FillError) $ fillConfigItems varyingOptions $ BSL.toStrict $ TL.encodeUtf8 stdout--  let filledOptions | Just resumeOptions <- maybeResumeOptions = baseOptions `replaceItemsWith` resumeOptions-                    | otherwise = baseOptions--  pure InitializeOptionsResult { .. }-  where-    hardcodedOptsNames = name <$> hardcodedOpts--parseUserOpts :: (MonadError String m, ParseableConfigState f) => [String] -> [ConfigItemT f] -> m [ConfigItemT 'Value]-parseUserOpts opts baseOpts = forM opts $ splitStr >=> findBaseOpt >=> uncurry parseConfigValue-  where-    splitStr str | (name, _:valStr) <- break (== ':') str = pure (T.splitOn "." $ T.pack name, valStr)-                 | otherwise = throwError [i|Unable to parse `#{str}`: it should have the form of `name:value`|]-    findBaseOpt (name, valStr) | Just item <- HM.lookup name baseOptsMap = pure (item, valStr)-                               | otherwise = throwError [i|Unable to find option `#{name}`|]--    baseOptsMap = HM.fromList [ (name item, item) | item <- baseOpts]--data PipelineOpts = PipelineOpts-  { maxSubsetSize :: Maybe Natural-  , resumePath :: Maybe FilePath-  , input :: NonEmpty FilePath-  , taskGroup :: TaskGroup-  , forceStrs :: [String]-  }--runOptPipeline :: (MonadError String m, MonadLoggerIO m)-               => PipelineOpts -> m BS.ByteString-runOptPipeline PipelineOpts { .. } = do-  preparedFiles <- mapM prepareFile $ toList input--  InitializeOptionsResult { .. } <- initializeOptions preparedFiles resumePath forceStrs--  let categoricalVariables = [ IxedVariable dv idx-                             | (Just dv, idx) <- zip (typToDV . value <$> filledOptions) [0..]-                             ]-  let integralVariables = [ IxedVariable dv idx-                          | (Just dv, idx) <- zip (typToIV . value <$> filledOptions) [0..]-                          ]-  let constantOpts = hardcodedOpts <> userForcedOpts-  let fmtEnv = FmtEnv { .. }-  let optEnv = OptEnv { maxSubsetSize = fromMaybe 1 maxSubsetSize, .. }-  let optState = initOptState filledOptions baseScore-  finalOptState <- convert (show @UnexpectedFailure) $ flip runReaderT (fmtEnv, optEnv, taskGroup) $ execStateT (fixGD Nothing 1) optState-  let finalStyOpts = StyOpts { basedOnStyle = baseStyle-                             , additionalOpts = constantOpts <> currentOpts finalOptState `subtractMatching` baseOptions-                             }-  pure $ formatClangFormat finalStyOpts

@@ -1,70 +0,0 @@-{-# LANGUAGE DeriveGeneric, DerivingVia #-}-{-# LANGUAGE RecordWildCards, QuasiQuotes #-}--module Clang.Coformat.Score-( Score-, calcScore--, PreparedFile-, filename-, prepareFile-) where--import qualified Data.ByteString.Char8 as BS-import qualified Data.IntMap.Strict as IM-import Control.Monad.IO.Class-import Data.Char-import Data.Monoid-import Data.String.Interpolate-import GHC.Generics-import Generic.Data--type CharsHist = IM.IntMap Int--data PreparedFile = PreparedFile-  { filename :: FilePath-  , contents :: BS.ByteString-  , charsHist :: CharsHist-  } deriving (Eq)--prepareFile :: MonadIO m => FilePath -> m PreparedFile-prepareFile filename = do-  contents <- liftIO $ BS.readFile filename-  let charsHist = calcCharsHist contents-  pure $ PreparedFile { .. }--data Score = Score-  { significantLettersCountsDiff :: Sum Int-  , spacesMisalignment :: Sum Int-  } deriving (Eq, Ord, Bounded, Generic)-    deriving (Semigroup, Monoid) via (Generically Score)--instance Show Score where-  show Score { .. } = [i|Score { #{getSum significantLettersCountsDiff} / #{getSum spacesMisalignment} }|]--calcScore :: PreparedFile -> BS.ByteString -> Score-calcScore prepared str = Score { .. }-  where-    significantLettersCountsDiff = Sum $ calcCharsDiff (charsHist prepared) (calcCharsHist str)-    spacesMisalignment | significantLettersCountsDiff /= 0 = 0-                       | otherwise = Sum $ alignSpaces (contents prepared) str--calcCharsDiff :: CharsHist -> CharsHist -> Int-calcCharsDiff hm1 hm2 = sum $ IM.elems $ IM.unionWith (\v1 v2 -> abs $ v1 - v2) hm1 hm2--calcCharsHist :: BS.ByteString -> CharsHist-calcCharsHist = BS.foldl' ins mempty-  where-    ins hm ch | isSpace ch = hm-              | otherwise = IM.insertWith (+) (ord ch) 1 hm--alignSpaces :: BS.ByteString -> BS.ByteString -> Int-alignSpaces bs1 bs2 = go (BS.unpack bs1) (BS.unpack bs2)-  where-    go s1 [] = length s1-    go [] s2 = length s2-    go (c1:s1) (c2:s2) | c1 == c2 = go s1 s2-                       | isSpace c1 && isSpace c2 = 2 + go s1 s2-                       | isSpace c1 = 1 + go s1 (c2:s2)-                       | isSpace c2 = 1 + go (c1:s1) s2-                       | otherwise = 2 + length s1 + length s2

@@ -1,44 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts, GADTs #-}-{-# LANGUAGE RecordWildCards, OverloadedStrings #-}--module Clang.Coformat.StyOpts where--import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T-import Control.Lens-import Data.Aeson-import Data.Aeson.Lens(_Object)-import Data.List-import Data.Maybe-import Data.Void--import Clang.Format.Descr--data StyOpts = StyOpts-  { basedOnStyle :: T.Text-  , additionalOpts :: [ConfigItemT 'Value]-  }--instance ToJSON StyOpts where-  toJSON StyOpts { .. } = Object $ foldl' f (HM.singleton "BasedOnStyle" $ String basedOnStyle) additionalOpts-    where-      f hm ConfigItem { .. } = updateRec value name hm--      updateRec value [key] = HM.insert key (toJson value)-      updateRec value (key:rest) = HM.alter (Just . Object . updateRec value rest . getObj) key-      updateRec _ [] = id-      getObj = fromMaybe mempty . ((^? _Object) =<<)--      toJson (CTInt n) = Number $ fromIntegral n-      toJson (CTUnsigned n) = Number $ fromIntegral n-      toJson (CTString v) = absurd v-      toJson (CTStringVec v) = absurd v-      toJson (CTRawStringFormats v) = absurd v-      toJson (CTIncludeCats v) = absurd v-      toJson (CTBool b) = Bool b-      toJson (CTEnum _ opt) = String opt--formatStyArg :: StyOpts -> BSL.ByteString-formatStyArg = encode

@@ -1,78 +0,0 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}--module Clang.Coformat.Util where--import qualified Control.Concurrent.Async as A-import qualified Control.Concurrent.Async.Pool as A.P-import qualified Control.Monad.Except as E-import qualified Control.Monad.Reader as R-import qualified Data.Text.Lazy as TL-import Control.Monad.Except.CoHas-import Control.Monad.Logger-import Control.Monad.Reader.Has-import Data.Bifunctor-import GHC.Generics-import Numeric.Natural-import System.Exit--data ExpectedFailure = FormatterSegfaulted TL.Text   -- kek-  deriving (Eq, Show)--data UnexpectedFailure = FormatterFailure-  { errorCode :: Int-  , errorOutput :: TL.Text-  } deriving (Eq, Show)--data Failure = ExpectedFailure ExpectedFailure-             | UnexpectedFailure UnexpectedFailure-             deriving (Eq, Show, Generic, CoHas ExpectedFailure, CoHas UnexpectedFailure)--failuresAreUnexpected :: Failure -> UnexpectedFailure-failuresAreUnexpected (UnexpectedFailure err) = err-failuresAreUnexpected (ExpectedFailure (FormatterSegfaulted out)) = FormatterFailure 0 out--checked :: (MonadError err m, CoHas UnexpectedFailure err, CoHas ExpectedFailure err, MonadIO m)-        => IO (ExitCode, TL.Text, TL.Text) -> m TL.Text-checked act = do-  (ec, stdout, stderr) <- liftIO act-  case ec of ExitSuccess -> pure stdout-             ExitFailure n | n == cfCrashRetCode -> throwError $ FormatterSegfaulted stderr-                           | otherwise -> throwError $ FormatterFailure n stderr-  where-    cfCrashRetCode = -8--update :: Int -> (a -> a) -> [a] -> [a]-update idx f = zipWith z [0..]-  where z idx' val = if idx' == idx then f val else val--forConcurrently' :: (MonadLoggerIO m, MonadError e m)-                 => [a]-                 -> (forall m'. (MonadLoggerIO m', MonadError e m') => a -> m' b)-                 -> m [b]-forConcurrently' lst act = do-  logger <- askLoggerIO-  result <- liftIO $ A.forConcurrently lst $ \elt -> flip runLoggingT logger $ runExceptT $ act elt-  E.liftEither $ sequence result--forConcurrentlyPooled :: (MonadLoggerIO m, MonadError e m, MonadReader r m, Has A.P.TaskGroup r)-                      => [a]-                      -> (forall m'. (MonadLoggerIO m', MonadReader r m', MonadError e m') => a -> m' b)-                      -> m [b]-forConcurrentlyPooled lst act = do-  logger <- askLoggerIO-  tg <- ask-  env <- R.ask-  result <- liftIO $ flip (A.P.mapConcurrently tg) lst $ \elt -> flip runLoggingT logger $ runExceptT $ flip runReaderT env $ act elt-  E.liftEither $ sequence result--convert :: MonadError e' m-        => (e -> e')-        -> ExceptT e m a-        -> m a-convert cvt act = runExceptT act >>= (E.liftEither . first cvt)--subsetsN :: Natural -> [a] -> [[a]]-subsetsN _ [] = []-subsetsN 1 xs = pure <$> xs-subsetsN n (x:xs) = ((x:) <$> subsetsN (n - 1) xs) <> subsetsN n xs

@@ -1,94 +0,0 @@-{-# LANGUAGE GADTs, TypeFamilies, DataKinds, TypeApplications, ConstraintKinds #-}-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# OPTIONS_GHC -Wno-type-defaults #-}--module Clang.Coformat.Variables where--import qualified Data.Text as T-import Control.Lens-import Control.Monad-import Data.Kind-import Numeric.Natural--import Clang.Format.Descr--data KnownVariateType = Categorical | Integral--class Variate a where-  type VariateResult a :: Type -> Type-  type VariateType a :: KnownVariateType-  variate :: a -> VariateResult a a-  varPrism :: Prism' (ConfigTypeT 'Value) a--data Variable varTy where-  -- TODO proxy should be enough-  MkDV :: (Variate a, VariateType a ~ varTy, Foldable (VariateResult a)) => a -> Variable varTy--data IxedVariable varTy = IxedVariable-  { discreteVar :: Variable varTy-  , varIdx :: Int-  }--type CategoricalVariate a = (Variate a, VariateType a ~ 'Categorical)-type CategoricalVariable = Variable 'Categorical-type IxedCategoricalVariable = IxedVariable 'Categorical---instance Variate Bool where-  type VariateResult Bool = []-  type VariateType Bool = 'Categorical-  variate b = [not b]-  varPrism = prism' CTBool $ \case CTBool b -> Just b-                                   _ -> Nothing--type EnumVar = ([T.Text], T.Text)--instance Variate EnumVar where-  type VariateResult EnumVar = []-  type VariateType EnumVar = 'Categorical-  variate (vars, cur) = [(vars, next) | next <- vars, next /= cur]-  varPrism = prism' (uncurry CTEnum) $ \case CTEnum vars cur -> Just (vars, cur)-                                             _ -> Nothing--typToDV :: ConfigTypeT 'Value -> Maybe CategoricalVariable-typToDV val = msum [ MkDV <$> val ^? varPrism @Bool-                   , MkDV <$> val ^? varPrism @([T.Text], T.Text)-                   ]--searchSpace :: Show a => Integral a => a -> [a]-searchSpace n = [ 2 ^ k | k <- [ 0 .. maxK ] ]-  where-    nBase = round $ logBase 2 $ fromIntegral n-    maxK | n > 100 = nBase + 1-         | otherwise = 2 * nBase--instance Variate Int where-  type VariateResult Int = []-  type VariateType Int = 'Integral-  variate n = n - 1 : n + 1 : searchSpace n <> map negate (searchSpace n)-  varPrism = prism' CTInt $ \case CTInt n -> Just n-                                  _ -> Nothing--instance Variate Natural where-  type VariateResult Natural = []-  type VariateType Natural = 'Integral-  variate n | n > 0 = n - 1 : n + 1 : searchSpace n-            | otherwise = n + 1 : searchSpace n-  varPrism = prism' CTUnsigned $ \case CTUnsigned n -> Just n-                                       _ -> Nothing--type IntegralVariate a = (Variate a, VariateType a ~ 'Integral)-type IntegralVariable = Variable 'Integral-type IxedIntegralVariable = IxedVariable 'Integral--typToIV :: ConfigTypeT 'Value -> Maybe IntegralVariable-typToIV val = msum [ MkDV <$> val ^? varPrism @Int-                   , MkDV <$> val ^? varPrism @Natural-                   ]--data SomeIxedVariable :: Type where-  SomeIxedVariable :: IxedVariable varTy -> SomeIxedVariable--asSome :: [IxedVariable varTy] -> [SomeIxedVariable]-asSome = fmap SomeIxedVariable

@@ -1,41 +0,0 @@-{-# LANGUAGE DataKinds, TypeFamilies #-}-{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}-{-# LANGUAGE Strict #-}--module Clang.Format.Descr where--import qualified Data.Text as T-import Data.Void-import Numeric.Natural--data Stage = Parsed | Supported | Value--type family CTData f ty where-  CTData 'Parsed _ = ()-  CTData 'Supported Void = Void-  CTData 'Supported _ = ()-  CTData 'Value ty = ty--data ConfigTypeT f-  = CTInt (CTData f Int)-  | CTUnsigned (CTData f Natural)-  | CTBool (CTData f Bool)-  | CTString (CTData f Void)-  | CTStringVec (CTData f Void)-  | CTRawStringFormats (CTData f Void)-  | CTIncludeCats (CTData f Void)-  | CTEnum { variants :: [T.Text], enumValue :: CTData f T.Text }--deriving instance Show (ConfigTypeT 'Parsed)-deriving instance Show (ConfigTypeT 'Supported)-deriving instance Show (ConfigTypeT 'Value)-deriving instance Eq (ConfigTypeT 'Value)--data ConfigItemT f = ConfigItem-  { name :: [T.Text]-  , value :: ConfigTypeT f-  }--deriving instance Show (ConfigItemT 'Parsed)-deriving instance Show (ConfigItemT 'Supported)-deriving instance Show (ConfigItemT 'Value)

@@ -1,61 +0,0 @@-{-# LANGUAGE DataKinds, GADTs, ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards, LambdaCase, QuasiQuotes, OverloadedStrings #-}--module Clang.Format.Descr.Operations where--import qualified Data.HashMap.Strict as HM-import qualified Data.Map.Strict as M-import qualified Data.Text as T-import Control.Monad.Except-import Data.Bifunctor-import Data.Maybe-import Data.String.Interpolate.IsString-import Data.Typeable-import Data.Void-import Text.Read--import Clang.Format.Descr--filterParsedItems :: [ConfigItemT 'Parsed] -> [ConfigItemT 'Supported]-filterParsedItems = mapMaybe $ \ConfigItem { .. } -> ConfigItem name <$> filterType value-  where-    filterType = \case-                    CTInt () -> Just $ CTInt ()-                    CTUnsigned () -> Just $ CTUnsigned ()-                    CTBool () -> Just $ CTBool ()-                    CTString () -> Nothing-                    CTStringVec () -> Nothing-                    CTRawStringFormats () -> Nothing-                    CTIncludeCats () -> Nothing-                    CTEnum vars () -> Just $ CTEnum vars ()--replaceItemsWith :: [ConfigItemT 'Value] -> [ConfigItemT 'Value] -> [ConfigItemT 'Value]-replaceItemsWith l1 l2 = M.elems $ toMap l2 <> toMap l1-  where-    toMap lst = M.fromList [ (name item, item) | item <- lst ]--subtractMatching :: [ConfigItemT 'Value] -> [ConfigItemT 'Value] -> [ConfigItemT 'Value]-subtractMatching minuend subtrahend = filter f minuend-  where-    f ConfigItem { .. } = (/= Just value) $ HM.lookup name subMap-    subMap = HM.fromList [ (name, value) | ConfigItem { .. } <- subtrahend]--type ParseableConfigState f = (CTData f Void ~ Void, Show (ConfigTypeT f))--parseConfigValue :: (MonadError String m, ParseableConfigState f) => ConfigItemT f -> String -> m (ConfigItemT 'Value)-parseConfigValue cfg str = liftEither $ (\parsed -> ConfigItem { name = name cfg, value = parsed }) <$> eitherParsed-  where-    eitherParsed = case value cfg of-                        CTInt _ -> CTInt <$> readEither'-                        CTUnsigned _ -> CTUnsigned <$> readEither'-                        CTBool _ -> CTBool <$> readEither'-                        CTString val -> absurd val-                        CTStringVec val -> absurd val-                        CTRawStringFormats val -> absurd val-                        CTIncludeCats val -> absurd val-                        CTEnum variants _ | var `elem` variants -> pure $ CTEnum variants var-                                          | otherwise -> throwError [i|Unsupported option `#{var}`, supported ones are `#{T.intercalate "`, `" variants}`|]-                            where var = T.pack str-    readEither' :: forall a. (Typeable a, Read a) => Either String a-    readEither' = first (\err -> [i|Error parsing #{str} as #{typeRep (Proxy :: Proxy a)}: #{err}, expected type: #{value cfg}|]) $ readEither str

@@ -2,8 +2,7 @@ {-# LANGUAGE DataKinds, GADTs #-}  module Clang.Format.DescrParser-( parseFile-, parseDescr+( parseDescr ) where  import qualified Data.ByteString.Lazy.Char8 as LBS@@ -19,10 +18,7 @@ import Text.XML.Selector.TH import Text.XML.Selector.Types -import Clang.Format.Descr--parseFile :: FilePath -> IO (Either String [ConfigItemT 'Parsed])-parseFile = fmap parseDescr . LBS.readFile+import Language.Coformat.Descr  parseDescr :: LBS.ByteString -> Either String [ConfigItemT 'Parsed] parseDescr = parseCursor . fromDocument . parseLBS

@@ -0,0 +1,72 @@+{-# LANGUAGE GADTs, TypeApplications, DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards, QuasiQuotes, OverloadedStrings #-}++module Clang.Format.Formatter(clangFormatter) where++import qualified Control.Monad.Except.CoHas as EC+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.HashMap.Strict as HM+import Control.Lens+import Control.Monad.Except+import Data.Aeson.Lens+import Data.Bifunctor+import Data.List+import Data.String.Interpolate++import Clang.Format.DescrParser+import Clang.Format.StyOpts+import Clang.Format.YamlConversions+import Language.Coformat.Descr+import Language.Coformat.Descr.Operations+import Language.Coformat.Formatter+import Language.Coformat.Util++clangFormatter :: Formatter+clangFormatter = Formatter { .. }+  where+    formatterInfo = FormatterInfo { .. }+      where+        execName = "clang-format"+        formatterOpts = OptsFromFile "data/ClangFormatStyleOptions-9.html" parseOptsDescription+        hardcodedOpts = [ ConfigItem { name = ["Language"], value = CTEnum ["Cpp"] "Cpp" }+                        , ConfigItem { name = ["BreakBeforeBraces"], value = CTEnum ["Custom"] "Custom" }+                        , ConfigItem { name = ["DisableFormat"], value = CTBool False }+                        , ConfigItem { name = ["SortIncludes"], value = CTBool False }+                        ]+        defaultStyleOpts sty supported allFixedOpts = OptsFromCmd (CmdArgs args) parser+          where+            args = [ "--style=" <> formattedBaseSty, "--dump-config" ]+            parser = convert (show @FillError) . fillConfigItems supported+            formattedBaseSty = formatStyArg $ StyOpts { basedOnStyle = sty, additionalOpts = allFixedOpts }++        formatFile baseSty opts path = CmdArgs { args = [ "--style=" <> formattedBaseSty, BS.pack path ] }+          where+            formattedBaseSty = formatStyArg $ StyOpts { basedOnStyle = baseSty, additionalOpts = opts }++        serializeOptions baseSty opts = formatClangFormat StyOpts { basedOnStyle = baseSty, additionalOpts = opts }++    parseResumeObject = convert (show @FillError) . preprocessYaml PartialConfig+    parseResumeOptions knownOpts resumeObj = do+      baseStyle <- EC.liftMaybe ("Unable to find `BasedOnStyle` key in the resume file" :: String)+                $ HM.lookup "BasedOnStyle" resumeObj ^? _Just . _String+      opts <- convert (show @FillError) $ collectConfigItems knownOpts resumeObj+      pure (baseStyle, opts)++liftEither' :: (MonadError String m, Show e) => String -> Either e a -> m a+liftEither' context = liftEither . first ((context <>) . show)++parseOptsDescription :: LBS.ByteString -> Either String (OptsDescription 'Supported)+parseOptsDescription contents = do+  parseResult <- liftEither' "Unable to parse the file: " $ parseDescr contents+  let supportedOptions = filterParsedItems parseResult+  baseStyles <- case find ((== bosKey) . name) supportedOptions of+                     Nothing -> throwError "No `BasedOnStyle` option"+                     Just stys -> pure stys+  let varyingOptions = filter ((/= bosKey) . name) supportedOptions+  case value baseStyles of+       CTEnum { .. } -> pure $ OptsDescription { baseStyles = variants, knownOpts = varyingOptions }+       _ -> throwError [i|Unknown type for the `BaseStyles` option: #{value baseStyles}|]+  where+    bosKey = ["BasedOnStyle"]

@@ -0,0 +1,45 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts, GADTs #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}++module Clang.Format.StyOpts where++import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import Control.Lens+import Data.Aeson+import Data.Aeson.Lens(_Object)+import Data.List+import Data.Maybe+import Data.Void++import Language.Coformat.Descr++data StyOpts = StyOpts+  { basedOnStyle :: T.Text+  , additionalOpts :: [ConfigItemT 'Value]+  }++instance ToJSON StyOpts where+  toJSON StyOpts { .. } = Object $ foldl' f (HM.singleton "BasedOnStyle" $ String basedOnStyle) additionalOpts+    where+      f hm ConfigItem { .. } = updateRec value name hm++      updateRec value [key] = HM.insert key (toJson value)+      updateRec value (key:rest) = HM.alter (Just . Object . updateRec value rest . getObj) key+      updateRec _ [] = id+      getObj = fromMaybe mempty . ((^? _Object) =<<)++      toJson (CTInt n) = Number $ fromIntegral n+      toJson (CTUnsigned n) = Number $ fromIntegral n+      toJson (CTString v) = absurd v+      toJson (CTStringVec v) = absurd v+      toJson (CTRawStringFormats v) = absurd v+      toJson (CTIncludeCats v) = absurd v+      toJson (CTBool b) = Bool b+      toJson (CTEnum _ opt) = String opt++formatStyArg :: StyOpts -> BS.ByteString+formatStyArg = BSL.toStrict . encode

@@ -25,8 +25,8 @@ import Data.Yaml.Pretty import GHC.Generics -import Clang.Format.Descr-import Clang.Coformat.StyOpts+import Clang.Format.StyOpts+import Language.Coformat.Descr  data FillError   = YamlParseError ParseException

@@ -0,0 +1,41 @@+{-# LANGUAGE DataKinds, TypeFamilies #-}+{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}+{-# LANGUAGE Strict #-}++module Language.Coformat.Descr where++import qualified Data.Text as T+import Data.Void+import Numeric.Natural++data Stage = Parsed | Supported | Value++type family CTData f ty where+  CTData 'Parsed _ = ()+  CTData 'Supported Void = Void+  CTData 'Supported _ = ()+  CTData 'Value ty = ty++data ConfigTypeT f+  = CTInt (CTData f Int)+  | CTUnsigned (CTData f Natural)+  | CTBool (CTData f Bool)+  | CTString (CTData f Void)+  | CTStringVec (CTData f Void)+  | CTRawStringFormats (CTData f Void)+  | CTIncludeCats (CTData f Void)+  | CTEnum { variants :: [T.Text], enumValue :: CTData f T.Text }++deriving instance Show (ConfigTypeT 'Parsed)+deriving instance Show (ConfigTypeT 'Supported)+deriving instance Show (ConfigTypeT 'Value)+deriving instance Eq (ConfigTypeT 'Value)++data ConfigItemT f = ConfigItem+  { name :: [T.Text]+  , value :: ConfigTypeT f+  }++deriving instance Show (ConfigItemT 'Parsed)+deriving instance Show (ConfigItemT 'Supported)+deriving instance Show (ConfigItemT 'Value)

@@ -0,0 +1,61 @@+{-# LANGUAGE DataKinds, GADTs, ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards, LambdaCase, QuasiQuotes, OverloadedStrings #-}++module Language.Coformat.Descr.Operations where++import qualified Data.HashMap.Strict as HM+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import Control.Monad.Except+import Data.Bifunctor+import Data.Maybe+import Data.String.Interpolate.IsString+import Data.Typeable+import Data.Void+import Text.Read++import Language.Coformat.Descr++filterParsedItems :: [ConfigItemT 'Parsed] -> [ConfigItemT 'Supported]+filterParsedItems = mapMaybe $ \ConfigItem { .. } -> ConfigItem name <$> filterType value+  where+    filterType = \case+                    CTInt () -> Just $ CTInt ()+                    CTUnsigned () -> Just $ CTUnsigned ()+                    CTBool () -> Just $ CTBool ()+                    CTString () -> Nothing+                    CTStringVec () -> Nothing+                    CTRawStringFormats () -> Nothing+                    CTIncludeCats () -> Nothing+                    CTEnum vars () -> Just $ CTEnum vars ()++replaceItemsWith :: [ConfigItemT 'Value] -> [ConfigItemT 'Value] -> [ConfigItemT 'Value]+replaceItemsWith l1 l2 = M.elems $ toMap l2 <> toMap l1+  where+    toMap lst = M.fromList [ (name item, item) | item <- lst ]++subtractMatching :: [ConfigItemT 'Value] -> [ConfigItemT 'Value] -> [ConfigItemT 'Value]+subtractMatching minuend subtrahend = filter f minuend+  where+    f ConfigItem { .. } = (/= Just value) $ HM.lookup name subMap+    subMap = HM.fromList [ (name, value) | ConfigItem { .. } <- subtrahend]++type ParseableConfigState f = (CTData f Void ~ Void, Show (ConfigTypeT f))++parseConfigValue :: (MonadError String m, ParseableConfigState f) => ConfigItemT f -> String -> m (ConfigItemT 'Value)+parseConfigValue cfg str = liftEither $ (\parsed -> ConfigItem { name = name cfg, value = parsed }) <$> eitherParsed+  where+    eitherParsed = case value cfg of+                        CTInt _ -> CTInt <$> readEither'+                        CTUnsigned _ -> CTUnsigned <$> readEither'+                        CTBool _ -> CTBool <$> readEither'+                        CTString val -> absurd val+                        CTStringVec val -> absurd val+                        CTRawStringFormats val -> absurd val+                        CTIncludeCats val -> absurd val+                        CTEnum variants _ | var `elem` variants -> pure $ CTEnum variants var+                                          | otherwise -> throwError [i|Unsupported option `#{var}`, supported ones are `#{T.intercalate "`, `" variants}`|]+                            where var = T.pack str+    readEither' :: forall a. (Typeable a, Read a) => Either String a+    readEither' = first (\err -> [i|Error parsing #{str} as #{typeRep (Proxy :: Proxy a)}: #{err}, expected type: #{value cfg}|]) $ readEither str

@@ -0,0 +1,64 @@+{-# LANGUAGE DataKinds, GADTs, RankNTypes, TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++module Language.Coformat.Formatter where++import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Text as T+import Control.Monad.Except.CoHas+import System.Command hiding(cmd)+import System.Exit++import Language.Coformat.Descr+import Language.Coformat.Formatter.Failure+import Language.Coformat.Util++data OptsDescription stage = OptsDescription+  { knownOpts :: [ConfigItemT stage]+  , baseStyles :: [T.Text]+  }++data OptsSource opts+  = StaticOpts opts+  | OptsFromFile FilePath (LBS.ByteString -> Either String opts)+  | OptsFromCmd CmdArgs (BS.ByteString -> Either String opts)++parseOpts :: (MonadIO m, MonadError String m) => String -> OptsSource opts -> m opts+parseOpts _     (StaticOpts d) = pure d+parseOpts _     (OptsFromFile path parser) = parser <$> liftIO (LBS.readFile path) >>= liftEither+parseOpts exec  (OptsFromCmd args parser) = convert (show @Failure) (runCommand exec args) >>= liftEither . parser++data FormatterInfo = FormatterInfo+  { execName :: String++  , formatterOpts :: OptsSource (OptsDescription 'Supported)+  , hardcodedOpts :: [ConfigItemT 'Value]+  , defaultStyleOpts :: T.Text -> [ConfigItemT 'Supported] -> [ConfigItemT 'Value] -> OptsSource [ConfigItemT 'Value]++  , formatFile :: T.Text -> [ConfigItemT 'Value] -> FilePath -> CmdArgs++  , serializeOptions :: T.Text -> [ConfigItemT 'Value] -> BS.ByteString+  }++newtype CmdArgs = CmdArgs+  { args :: [BS.ByteString]+  } deriving (Show)++runCommand :: (MonadError err m, CoHas UnexpectedFailure err, CoHas ExpectedFailure err, MonadIO m)+           => String -> CmdArgs -> m BS.ByteString+runCommand exec (CmdArgs args) = do+  (ec, stdout, stderr) <- liftIO $ command [] exec $ BS.unpack <$> args+  case ec of ExitSuccess -> pure $ BS.pack $ fromStdout stdout+             ExitFailure n | n == cfCrashRetCode -> throwError $ FormatterSegfaulted $ T.pack $ fromStderr stderr+                           | otherwise -> throwError $ FormatterFailure n $ T.pack $ fromStderr stderr+  where+    cfCrashRetCode = -8++data Formatter where+  Formatter :: forall resumeObj.+               { formatterInfo :: FormatterInfo+               , parseResumeObject :: BS.ByteString -> Either String resumeObj+               , parseResumeOptions :: [ConfigItemT 'Supported] -> resumeObj -> Either String (T.Text, [ConfigItemT 'Value])+               } -> Formatter

@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}++module Language.Coformat.Formatter.Failure where++import qualified Data.Text as T+import Control.Monad.Except.CoHas+import GHC.Generics++data ExpectedFailure = FormatterSegfaulted T.Text   -- kek+  deriving (Eq, Show)++data UnexpectedFailure = FormatterFailure+  { errorCode :: Int+  , errorOutput :: T.Text+  } deriving (Eq, Show)++data Failure = ExpectedFailure ExpectedFailure+             | UnexpectedFailure UnexpectedFailure+             deriving (Eq, Show, Generic, CoHas ExpectedFailure, CoHas UnexpectedFailure)++failuresAreUnexpected :: Failure -> UnexpectedFailure+failuresAreUnexpected (UnexpectedFailure err) = err+failuresAreUnexpected (ExpectedFailure (FormatterSegfaulted out)) = FormatterFailure 0 out

@@ -0,0 +1,159 @@+{-# LANGUAGE GADTs, DataKinds, TypeApplications, RankNTypes, ScopedTypeVariables, ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE QuasiQuotes, RecordWildCards, TupleSections, LambdaCase, OverloadedStrings #-}++module Language.Coformat.Optimization where++import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import Control.Concurrent.Async.Pool+import Control.Lens+import Control.Monad.Except.CoHas+import Control.Monad.Extra+import Control.Monad.Logger+import Control.Monad.Reader.Has hiding(update)+import Control.Monad.State.Strict+import Data.Foldable+import Data.List+import Data.Ord+import Data.Proxy+import Data.String.Interpolate.IsString+import Numeric.Natural++import Language.Coformat.Descr+import Language.Coformat.Formatter+import Language.Coformat.Formatter.Failure+import Language.Coformat.Score+import Language.Coformat.Util+import Language.Coformat.Variables++data FmtEnv = FmtEnv+  { baseStyle :: T.Text+  , preparedFiles :: [PreparedFile]+  , constantOpts :: [ConfigItemT 'Value]+  , formatterInfo :: FormatterInfo+  }++data OptEnv = OptEnv+  { categoricalVariables :: [IxedCategoricalVariable]+  , integralVariables :: [IxedIntegralVariable]+  , maxSubsetSize :: Natural+  }++runFormat :: (MonadError err m, CoHas UnexpectedFailure err, CoHas ExpectedFailure err, MonadIO m, MonadLogger m)+          => FormatterInfo -> PreparedFile -> String -> T.Text -> [ConfigItemT 'Value] -> m Score+runFormat FormatterInfo { .. } prepared logStr baseSty opts = do+  stdout <- runCommand execName $ formatFile baseSty opts $ filename prepared+  let dist = calcScore prepared stdout+  logDebugN [i|#{logStr}: #{dist}|]+  pure dist++type OptMonad err r m = (MonadLoggerIO m, MonadError err m, CoHas UnexpectedFailure err, MonadReader r m, Has FmtEnv r)++runFormatFiles :: (OptMonad err r m, CoHas ExpectedFailure err)+               => [ConfigItemT 'Value] -> String -> m Score+runFormatFiles varOpts logStr = do+  FmtEnv { .. } <- ask+  fmap mconcat $ forM preparedFiles $ \prepared -> runFormat formatterInfo prepared [i|#{logStr} at #{filename prepared}|] baseStyle $ constantOpts <> varOpts++chooseBaseStyle :: (MonadError String m, MonadLoggerIO m)+                => FormatterInfo -> [T.Text] -> [ConfigItemT 'Value] -> [PreparedFile] -> m (T.Text, Score)+chooseBaseStyle formatter baseStyles predefinedOpts files = do+  sty2dists <- forConcurrently' ((,) <$> baseStyles <*> files) $ \(sty, file) ->+    convert (show @(Either ExpectedFailure UnexpectedFailure)) $ (sty,) <$> runFormat formatter file [i|Initial guess for #{sty} at #{filename file}|] sty predefinedOpts+  let accumulated = HM.toList $ HM.fromListWith (<>) sty2dists+  forM_ accumulated $ \(sty, acc) -> logInfoN [i|Initial accumulated guess for #{sty}: #{acc}|]+  pure $ minimumBy (comparing snd) accumulated++variateAt :: forall a. (Variate a, Foldable (VariateResult a))+          => Proxy a -> Int -> [ConfigItemT 'Value] -> [[ConfigItemT 'Value]]+variateAt _ idx opts = [ update idx (updater v') opts | v' <- toList variated ]+  where+    thePrism :: Prism' (ConfigTypeT 'Value) a+    thePrism = varPrism+    variated = variate $ value (opts !! idx) ^?! thePrism+    updater v cfg = cfg { value = value cfg & thePrism .~ v }++data OptState = OptState+  { currentOpts :: [ConfigItemT 'Value]+  , currentScore :: Score+  } deriving (Show)++initOptState :: [ConfigItemT 'Value] -> Score -> OptState+initOptState currentOpts currentScore = OptState { .. }++dropExpectedFailures :: OptMonad err r m+                     => (forall err' r' m'. (OptMonad err' r' m', CoHas ExpectedFailure err') => m' Score)+                     -> m Score+dropExpectedFailures act = do+  res <- runExceptT act+  case res of+       Left (UnexpectedFailure failure) -> throwError failure+       Left (ExpectedFailure failure) -> do+         logErrorN [i|Unable to run the formatter: #{show failure}|]+         pure maxBound+       Right sc -> pure sc++variateSubset :: [SomeIxedVariable] -> [ConfigItemT 'Value] -> [[ConfigItemT 'Value]]+variateSubset [] opts = [opts]+variateSubset (SomeIxedVariable (IxedVariable (MkDV (_ :: a)) idx) : rest) opts = concatMap (variateSubset rest) $ variateAt @a Proxy idx opts++showVariated :: [SomeIxedVariable] -> [ConfigItemT 'Value] -> String+showVariated vars opts = intercalate ", " [showVar var | var <- vars]+  where+    showVar (SomeIxedVariable (IxedVariable _ idx)) = [i|#{name $ opts !! idx} -> #{value $ opts !! idx}|]++chooseBestSubset :: (OptMonad err r m, Has OptState r, Has TaskGroup r)+                 => Natural -> [SomeIxedVariable] -> m (Maybe ([ConfigItemT 'Value], Score))+chooseBestSubset subsetSize ixedVariables = do+  OptState { .. } <- ask+  FmtEnv { .. } <- ask+  partialResults <- forConcurrentlyPooled (subsetsN subsetSize ixedVariables) $ \someVarsSubset -> do+    opt2scores <- forM (variateSubset someVarsSubset currentOpts) $ \opts' ->+      fmap (opts',) $ dropExpectedFailures $ runFormatFiles opts' $ showVariated someVarsSubset opts'+    let (bestOpts, bestScore) = minimumBy (comparing snd) opt2scores+    when (bestScore < currentScore) $+      logInfoN [i|Total dist for #{showVariated someVarsSubset bestOpts}: #{currentScore} -> #{bestScore}|]+    pure (bestOpts, bestScore, someVarsSubset)+  let (bestOpts, bestScore, bestVarsSubset) = minimumBy (comparing (^. _2)) partialResults+  if bestScore < currentScore+    then do+      logInfoN [i|Choosing #{showVariated bestVarsSubset bestOpts}|]+      pure $ Just (bestOpts, bestScore)+    else pure Nothing++stepGDGeneric' :: (OptMonad err r m, Has TaskGroup r, Has OptEnv r, MonadState OptState m)+               => Natural -> [OptEnv -> [SomeIxedVariable]] -> m ()+stepGDGeneric' subsetSize varGetters = do+  current <- get+  fmtEnv@FmtEnv { .. } <- ask+  optEnv <- ask+  tg :: TaskGroup <- ask+  runReaderT (chooseBestSubset subsetSize $ concatMap ($ optEnv) varGetters) (current, fmtEnv, tg) >>=+    \case Nothing -> pure ()+          Just (opts', score') -> do+            logInfoN [i|Total score after optimization on all files: #{score'}|]+            put OptState { currentOpts = opts', currentScore = score' }++stepGDGeneric :: (OptMonad err r m, Has TaskGroup r, Has OptEnv r, MonadState OptState m)+              => Natural -> [OptEnv -> [SomeIxedVariable]] -> m ()+stepGDGeneric subsetSize varGetters = whenM ((> mempty) <$> gets currentScore) $ stepGDGeneric' subsetSize varGetters++fixGD :: (OptMonad err r m, Has TaskGroup r, Has OptEnv r, MonadState OptState m, err ~ UnexpectedFailure)+      => Maybe Int -> Natural -> m ()+fixGD (Just 0) _ = pure ()+fixGD counter curSubsetSize = do+  maxSubsetSize' <- asks maxSubsetSize+  if curSubsetSize > maxSubsetSize'+    then logInfoN [i|Done optimizing|]+    else do+      startScore <- gets currentScore+      stepGDGeneric curSubsetSize [asSome . categoricalVariables, asSome . integralVariables]+      endScore <- gets currentScore+      logInfoN [i|Full optimization step done, went from #{startScore} to #{endScore}|]+      if startScore /= endScore+        then fixGD (subtract 1 <$> counter) 1+        else do+          logInfoN [i|Done optimizing with subset size #{curSubsetSize}, stopped at score #{endScore}|]+          fixGD (subtract 1 <$> counter) (curSubsetSize + 1)

@@ -0,0 +1,109 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DataKinds, GADTs #-}+{-# LANGUAGE TypeApplications, OverloadedStrings, RecordWildCards, QuasiQuotes #-}++module Language.Coformat.Pipeline+( runOptPipeline+, PipelineOpts(..)+) where++import qualified Data.ByteString.Char8 as BS+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import Control.Concurrent.Async.Pool+import Control.Monad.Except+import Control.Monad.Logger+import Control.Monad.Reader+import Control.Monad.State.Strict+import Data.Foldable+import Data.List.NonEmpty(NonEmpty)+import Data.Maybe+import Data.String.Interpolate.IsString+import Data.Traversable+import Numeric.Natural++import Language.Coformat.Descr+import Language.Coformat.Descr.Operations+import Language.Coformat.Formatter+import Language.Coformat.Formatter.Failure+import Language.Coformat.Optimization+import Language.Coformat.Score+import Language.Coformat.Util+import Language.Coformat.Variables++data InitializeOptionsResult = InitializeOptionsResult+  { baseStyle :: T.Text+  , baseScore :: Score+  , baseOptions :: [ConfigItemT 'Value]+  , filledOptions :: [ConfigItemT 'Value]+  , userForcedOpts :: [ConfigItemT 'Value]+  }++initializeOptions :: (MonadError String m, MonadLoggerIO m)+                  => Formatter -> [PreparedFile] -> Maybe FilePath -> [String] -> m InitializeOptionsResult+initializeOptions Formatter { formatterInfo = formatterInfo@FormatterInfo { .. }, .. } preparedFiles maybeResumePath forceStrs = do+  OptsDescription { .. } <- parseOpts execName formatterOpts+  let varyingOptions = filter (not . (`elem` hardcodedOptsNames) . name) knownOpts+  userForcedOpts <- parseUserOpts forceStrs knownOpts++  let allFixedOpts = hardcodedOpts <> userForcedOpts++  maybeResumeObj <- for maybeResumePath $ liftIO . BS.readFile >=> liftEither . parseResumeObject+  maybeResumeOptions <- for maybeResumeObj $ liftEither . parseResumeOptions varyingOptions++  (baseStyle, baseScore) <-+      case maybeResumeOptions of+           Nothing -> chooseBaseStyle formatterInfo baseStyles allFixedOpts preparedFiles+           Just (baseStyle, constantOpts) -> do+              let fmtAct = runFormatFiles allFixedOpts [i|Calculating the score of the resumed-from style|]+              score <- convert (show @Failure) $ runReaderT fmtAct FmtEnv { .. }+              pure (baseStyle, score)++  logInfoN [i|Using initial style: #{baseStyle} with score of #{baseScore}|]+  baseOptions <- parseOpts execName $ defaultStyleOpts baseStyle varyingOptions allFixedOpts++  let filledOptions | Just (_, resumeOptions) <- maybeResumeOptions = baseOptions `replaceItemsWith` resumeOptions+                    | otherwise = baseOptions++  pure InitializeOptionsResult { .. }+  where+    hardcodedOptsNames = name <$> hardcodedOpts++parseUserOpts :: (MonadError String m, ParseableConfigState f) => [String] -> [ConfigItemT f] -> m [ConfigItemT 'Value]+parseUserOpts opts baseOpts = forM opts $ splitStr >=> findBaseOpt >=> uncurry parseConfigValue+  where+    splitStr str | (name, _:valStr) <- break (== ':') str = pure (T.splitOn "." $ T.pack name, valStr)+                 | otherwise = throwError [i|Unable to parse `#{str}`: it should have the form of `name:value`|]+    findBaseOpt (name, valStr) | Just item <- HM.lookup name baseOptsMap = pure (item, valStr)+                               | otherwise = throwError [i|Unable to find option `#{name}`|]++    baseOptsMap = HM.fromList [ (name item, item) | item <- baseOpts]++data PipelineOpts = PipelineOpts+  { maxSubsetSize :: Maybe Natural+  , resumePath :: Maybe FilePath+  , input :: NonEmpty FilePath+  , taskGroup :: TaskGroup+  , forceStrs :: [String]+  , formatter :: Formatter+  }++runOptPipeline :: (MonadError String m, MonadLoggerIO m)+               => PipelineOpts -> m BS.ByteString+runOptPipeline PipelineOpts { formatter = formatter@Formatter { .. }, .. } = do+  preparedFiles <- mapM prepareFile $ toList input++  InitializeOptionsResult { .. } <- initializeOptions formatter preparedFiles resumePath forceStrs++  let categoricalVariables = [ IxedVariable dv idx+                             | (Just dv, idx) <- zip (typToDV . value <$> filledOptions) [0..]+                             ]+  let integralVariables = [ IxedVariable dv idx+                          | (Just dv, idx) <- zip (typToIV . value <$> filledOptions) [0..]+                          ]+  let constantOpts = hardcodedOpts formatterInfo <> userForcedOpts+  let fmtEnv = FmtEnv { .. }+  let optEnv = OptEnv { maxSubsetSize = fromMaybe 1 maxSubsetSize, .. }+  let optState = initOptState filledOptions baseScore+  finalOptState <- convert (show @UnexpectedFailure) $ flip runReaderT (fmtEnv, optEnv, taskGroup) $ execStateT (fixGD Nothing 1) optState+  pure $ serializeOptions formatterInfo baseStyle $ constantOpts <> currentOpts finalOptState `subtractMatching` baseOptions

@@ -0,0 +1,70 @@+{-# LANGUAGE DeriveGeneric, DerivingVia #-}+{-# LANGUAGE RecordWildCards, QuasiQuotes #-}++module Language.Coformat.Score+( Score+, calcScore++, PreparedFile+, filename+, prepareFile+) where++import qualified Data.ByteString.Char8 as BS+import qualified Data.IntMap.Strict as IM+import Control.Monad.IO.Class+import Data.Char+import Data.Monoid+import Data.String.Interpolate+import GHC.Generics+import Generic.Data++type CharsHist = IM.IntMap Int++data PreparedFile = PreparedFile+  { filename :: FilePath+  , contents :: BS.ByteString+  , charsHist :: CharsHist+  } deriving (Eq)++prepareFile :: MonadIO m => FilePath -> m PreparedFile+prepareFile filename = do+  contents <- liftIO $ BS.readFile filename+  let charsHist = calcCharsHist contents+  pure $ PreparedFile { .. }++data Score = Score+  { significantLettersCountsDiff :: Sum Int+  , spacesMisalignment :: Sum Int+  } deriving (Eq, Ord, Bounded, Generic)+    deriving (Semigroup, Monoid) via (Generically Score)++instance Show Score where+  show Score { .. } = [i|Score { #{getSum significantLettersCountsDiff} / #{getSum spacesMisalignment} }|]++calcScore :: PreparedFile -> BS.ByteString -> Score+calcScore prepared str = Score { .. }+  where+    significantLettersCountsDiff = Sum $ calcCharsDiff (charsHist prepared) (calcCharsHist str)+    spacesMisalignment | significantLettersCountsDiff /= 0 = 0+                       | otherwise = Sum $ alignSpaces (contents prepared) str++calcCharsDiff :: CharsHist -> CharsHist -> Int+calcCharsDiff hm1 hm2 = sum $ IM.elems $ IM.unionWith (\v1 v2 -> abs $ v1 - v2) hm1 hm2++calcCharsHist :: BS.ByteString -> CharsHist+calcCharsHist = BS.foldl' ins mempty+  where+    ins hm ch | isSpace ch = hm+              | otherwise = IM.insertWith (+) (ord ch) 1 hm++alignSpaces :: BS.ByteString -> BS.ByteString -> Int+alignSpaces bs1 bs2 = go (BS.unpack bs1) (BS.unpack bs2)+  where+    go s1 [] = length s1+    go [] s2 = length s2+    go (c1:s1) (c2:s2) | c1 == c2 = go s1 s2+                       | isSpace c1 && isSpace c2 = 2 + go s1 s2+                       | isSpace c1 = 1 + go s1 (c2:s2)+                       | isSpace c2 = 1 + go (c1:s1) s2+                       | otherwise = 2 + length s1 + length s2

@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module Language.Coformat.Util where++import qualified Control.Concurrent.Async as A+import qualified Control.Concurrent.Async.Pool as A.P+import qualified Control.Monad.Except as E+import qualified Control.Monad.Reader as R+import Control.Monad.Except.CoHas+import Control.Monad.Logger+import Control.Monad.Reader.Has+import Data.Bifunctor+import Numeric.Natural++update :: Int -> (a -> a) -> [a] -> [a]+update idx f = zipWith z [0..]+  where z idx' val = if idx' == idx then f val else val++forConcurrently' :: (MonadLoggerIO m, MonadError e m)+                 => [a]+                 -> (forall m'. (MonadLoggerIO m', MonadError e m') => a -> m' b)+                 -> m [b]+forConcurrently' lst act = do+  logger <- askLoggerIO+  result <- liftIO $ A.forConcurrently lst $ \elt -> flip runLoggingT logger $ runExceptT $ act elt+  E.liftEither $ sequence result++forConcurrentlyPooled :: (MonadLoggerIO m, MonadError e m, MonadReader r m, Has A.P.TaskGroup r)+                      => [a]+                      -> (forall m'. (MonadLoggerIO m', MonadReader r m', MonadError e m') => a -> m' b)+                      -> m [b]+forConcurrentlyPooled lst act = do+  logger <- askLoggerIO+  tg <- ask+  env <- R.ask+  result <- liftIO $ flip (A.P.mapConcurrently tg) lst $ \elt -> flip runLoggingT logger $ runExceptT $ flip runReaderT env $ act elt+  E.liftEither $ sequence result++convert :: MonadError e' m+        => (e -> e')+        -> ExceptT e m a+        -> m a+convert cvt act = runExceptT act >>= (E.liftEither . first cvt)++subsetsN :: Natural -> [a] -> [[a]]+subsetsN _ [] = []+subsetsN 1 xs = pure <$> xs+subsetsN n (x:xs) = ((x:) <$> subsetsN (n - 1) xs) <> subsetsN n xs

@@ -0,0 +1,94 @@+{-# LANGUAGE GADTs, TypeFamilies, DataKinds, TypeApplications, ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++module Language.Coformat.Variables where++import qualified Data.Text as T+import Control.Lens+import Control.Monad+import Data.Kind+import Numeric.Natural++import Language.Coformat.Descr++data KnownVariateType = Categorical | Integral++class Variate a where+  type VariateResult a :: Type -> Type+  type VariateType a :: KnownVariateType+  variate :: a -> VariateResult a a+  varPrism :: Prism' (ConfigTypeT 'Value) a++data Variable varTy where+  -- TODO proxy should be enough+  MkDV :: (Variate a, VariateType a ~ varTy, Foldable (VariateResult a)) => a -> Variable varTy++data IxedVariable varTy = IxedVariable+  { discreteVar :: Variable varTy+  , varIdx :: Int+  }++type CategoricalVariate a = (Variate a, VariateType a ~ 'Categorical)+type CategoricalVariable = Variable 'Categorical+type IxedCategoricalVariable = IxedVariable 'Categorical+++instance Variate Bool where+  type VariateResult Bool = []+  type VariateType Bool = 'Categorical+  variate b = [not b]+  varPrism = prism' CTBool $ \case CTBool b -> Just b+                                   _ -> Nothing++type EnumVar = ([T.Text], T.Text)++instance Variate EnumVar where+  type VariateResult EnumVar = []+  type VariateType EnumVar = 'Categorical+  variate (vars, cur) = [(vars, next) | next <- vars, next /= cur]+  varPrism = prism' (uncurry CTEnum) $ \case CTEnum vars cur -> Just (vars, cur)+                                             _ -> Nothing++typToDV :: ConfigTypeT 'Value -> Maybe CategoricalVariable+typToDV val = msum [ MkDV <$> val ^? varPrism @Bool+                   , MkDV <$> val ^? varPrism @([T.Text], T.Text)+                   ]++searchSpace :: Show a => Integral a => a -> [a]+searchSpace n = [ 2 ^ k | k <- [ 0 .. maxK ] ]+  where+    nBase = round $ logBase 2 $ fromIntegral n+    maxK | n > 100 = nBase + 1+         | otherwise = 2 * nBase++instance Variate Int where+  type VariateResult Int = []+  type VariateType Int = 'Integral+  variate n = n - 1 : n + 1 : searchSpace n <> map negate (searchSpace n)+  varPrism = prism' CTInt $ \case CTInt n -> Just n+                                  _ -> Nothing++instance Variate Natural where+  type VariateResult Natural = []+  type VariateType Natural = 'Integral+  variate n | n > 0 = n - 1 : n + 1 : searchSpace n+            | otherwise = n + 1 : searchSpace n+  varPrism = prism' CTUnsigned $ \case CTUnsigned n -> Just n+                                       _ -> Nothing++type IntegralVariate a = (Variate a, VariateType a ~ 'Integral)+type IntegralVariable = Variable 'Integral+type IxedIntegralVariable = IxedVariable 'Integral++typToIV :: ConfigTypeT 'Value -> Maybe IntegralVariable+typToIV val = msum [ MkDV <$> val ^? varPrism @Int+                   , MkDV <$> val ^? varPrism @Natural+                   ]++data SomeIxedVariable :: Type where+  SomeIxedVariable :: IxedVariable varTy -> SomeIxedVariable++asSome :: [IxedVariable varTy] -> [SomeIxedVariable]+asSome = fmap SomeIxedVariable