<commit_before>
module System.Console.CmdArgs.Expand(defaults,expand,autoFlags) where

import System.Console.CmdArgs.Type
import Data.Dynamic
import Data.List
import Data.Maybe
import Data.Char
import Data.Function


---------------------------------------------------------------------
-- PRESUPPLIED ARGS

autoFlags :: [Flag]
autoFlags =
    [(f "!help" "?" "help" "Show usage information (optional format)")
        {flagType=fromJust $ toFlagType (typeOf ""),flagOpt=Just "",flagTyp="FORMAT"}
    ,f "!version" "V" "version" "Show version information"
    ,f "!verbose" "v" "verbose" "Higher verbosity"
    ,f "!quiet" "q" "quiet" "Lower verbosity"
    ]
    where f name short long text = flagDefault
            {flagName=name,flagKey=name,flagFlag=[short,long],flagText=text,flagType=FlagBool (toDyn True),flagVal=toDyn False,flagExplicit=True}

---------------------------------------------------------------------
-- FLAG DEFAULTS

-- FIXME: Add the string (default=foo) in the appropriate places
defaults :: a -> Flag -> Flag
defaults = error "todo" 


---------------------------------------------------------------------
-- FLAG EXPANSION
-- Introduce more long/short names

-- (keyname,([flags],explicit))
type FlagNames = [(String,([String],Bool))]

-- Error if:
--   Two things with the same FldName have different FldFlag or Explicit
--   Two fields without the same FldName have different FldFlag
expand :: [Mode a] -> [Mode a]
expand xs | not $ checkFlags ys = error "Flag's don't meet their condition"
          | otherwise = xs3
    where
        xs3 = map (\x -> x{modeFlags=[if isFlagArgs c then c else c{flagFlag=fst $ fromJust $ lookup (flagKey c) ys2} | c <- modeFlags x]}) xs2
        ys2 = assignShort $ assignLong ys
        ys = sort $ nub [(flagKey x, (flagFlag x, flagExplicit x)) | x <- map modeFlags xs2, x <- x, isFlagFlag x]
        xs2 = map (\x -> x{modeFlags = autoFlags ++ modeFlags x}) xs


checkFlags :: FlagNames -> Bool
checkFlags xs | any ((/=) 1 . length) $ groupBy ((==) `on` fst) xs = error "Two record names have different flags"
              | nub names /= names = error "One flag has been assigned twice"
              | otherwise = True
    where names = concatMap (fst . snd) xs


assignLong :: FlagNames -> FlagNames
assignLong xs = map f xs
    where
        seen = concatMap (fst . snd) xs
        f (name,(already,False)) | name `notElem` seen = (name,(g name:already,False))
        f x = x
        g xs | "_" `isSuffixOf` xs = g $ init xs
        g xs = [if x == '_' then '-' else x | x <- xs]

<commit_msg>Update checkFlags to provide more helpful error information.<commit_after>
module System.Console.CmdArgs.Expand(defaults,expand,autoFlags) where

import System.Console.CmdArgs.Type
import Data.Dynamic
import Data.List
import Data.Maybe
import Data.Char
import Data.Function


---------------------------------------------------------------------
-- PRESUPPLIED ARGS

autoFlags :: [Flag]
autoFlags =
    [(f "!help" "?" "help" "Show usage information (optional format)")
        {flagType=fromJust $ toFlagType (typeOf ""),flagOpt=Just "",flagTyp="FORMAT"}
    ,f "!version" "V" "version" "Show version information"
    ,f "!verbose" "v" "verbose" "Higher verbosity"
    ,f "!quiet" "q" "quiet" "Lower verbosity"
    ]
    where f name short long text = flagDefault
            {flagName=name,flagKey=name,flagFlag=[short,long],flagText=text,flagType=FlagBool (toDyn True),flagVal=toDyn False,flagExplicit=True}

---------------------------------------------------------------------
-- FLAG DEFAULTS

-- FIXME: Add the string (default=foo) in the appropriate places
defaults :: a -> Flag -> Flag
defaults = error "todo" 


---------------------------------------------------------------------
-- FLAG EXPANSION
-- Introduce more long/short names

-- (keyname,([flags],explicit))
type FlagNames = [(String,([String],Bool))]

-- Error if:
--   Two things with the same FldName have different FldFlag or Explicit
--   Two fields without the same FldName have different FldFlag
expand :: [Mode a] -> [Mode a]
expand xs | not $ checkFlags ys = error "Flag's don't meet their condition"
          | otherwise = xs3
    where
        xs3 = map (\x -> x{modeFlags=[if isFlagArgs c then c else c{flagFlag=fst $ fromJust $ lookup (flagKey c) ys2} | c <- modeFlags x]}) xs2
        ys2 = assignShort $ assignLong ys
        ys = sort $ nub [(flagKey x, (flagFlag x, flagExplicit x)) | x <- map modeFlags xs2, x <- x, isFlagFlag x]
        xs2 = map (\x -> x{modeFlags = autoFlags ++ modeFlags x}) xs


checkFlags :: FlagNames -> Bool
checkFlags xs | any ((/=) 1 . length) grouped = error group_err
              | nub names /= names = error dupflg_err
              | otherwise = True
    where names = concatMap (fst . snd) xs
          grouped = groupBy ((==) `on` fst) xs
          dups = filter ((/=) 1 . length) grouped
          group_err = intercalate "\n" $ flip map dups
                      (\d -> "Record name " ++ (fst $ head d) ++ " has different flags:" ++ (
                             intercalate " v.s. " $ map (show . fst . snd) d))
          dupnames = filter ((/=) 1 . length) $ group $ sort names
          dupflg_err = intercalate "\n" $ flip map dupnames
                       (\d -> "Flag " ++ (head d) ++ " has been assigned to " ++
                              (show $ length d) ++ " different arguments")

assignLong :: FlagNames -> FlagNames
assignLong xs = map f xs
    where
        seen = concatMap (fst . snd) xs
        f (name,(already,False)) | name `notElem` seen = (name,(g name:already,False))
        f x = x
        g xs | "_" `isSuffixOf` xs = g $ init xs
        g xs = [if x == '_' then '-' else x | x <- xs]


{'fraction_non_alphanumeric': 0.1945368586937489, 'fraction_numerical': 0.003151812292067939, 'mean_word_length': 2.145374449339207, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6252332', 'n_tokens_mistral': 1765, 'n_tokens_neox': 1668, 'n_words': 568}