1{-# LANGUAGE ViewPatterns #-} 2 3module Utils ( 4 makeCombinations 5 , make1Permutations 6 7 , extractIdenticalBit 8 9 , module Data.List 10 , same 11 , tailOrNull 12 , foldl1OrNull' 13 , productOrNull 14 15 , sortOpt 16 , wrapPercent 17 , dropPercentPrefix 18 , stripPrefix' 19 , toOptionsDbSubdir 20) where 21 22import Data.Bits 23import Data.List 24import Data.List.Extra (dropPrefix) 25import qualified Data.Text as T 26 27import Qm 28 29makeCombinations :: Int -> [[Bool]] 30makeCombinations len = map (toBoolList len) [0 .. numCombs] 31 where 32 numCombs = ((2 :: Int) ^ len) - 1 33 34 35make1Permutations :: Int -> [[Bool]] 36make1Permutations len = go $ 1 `shift` (len - 1) 37 where 38 go 0 = [] 39 go x = toBoolList len x : go (x `div` 2) 40 41 42toBoolList :: Int -> Int -> [Bool] 43toBoolList len x = flip map [(len - 1), (len - 2) .. 0] $ \b -> x `testBit` b 44 45 46-- In complex cases we can get something like [0-1, 01-] , 47-- which translates to %%NOOPT1%%%%OPT3%%_OR_%%NOOPT1%%%%OPT2%% 48-- We want to transform it into (0--,[--1,-1-]) 49-- which translates to %%NOOPT1%%%%OPT2_OR_OPT3%% 50extractIdenticalBit (t, ts) i = 51 if notMasked && allSame 52 then (newT, newTerms) 53 else (t, ts) 54 where 55 notMasked = all (\t -> not $ testBit (getMask t) i) ts 56 allSame = same $ map (flip testBit i . getTerm) ts 57 newT = QmTerm (adjustBit (getTerm t) i, clearBit (getMask t) i) 58 newTerms = flip map ts $ \(QmTerm (term, mask)) -> QmTerm (term, setBit mask i) 59 adjustBit = if testBit (getTerm $ head ts) i then setBit else clearBit 60 61 62same :: Eq a => [a] -> Bool 63same [] = error "same: empty list" 64same l = all (== head l) l 65 66 67tailOrNull :: [a] -> [a] 68tailOrNull [] = [] 69tailOrNull (e:es) = es 70 71foldl1OrNull' f [] = [] 72foldl1OrNull' f es = foldl1' f es 73 74productOrNull l [] = l 75productOrNull l r = (++) <$> l <*> r 76 77 78sortOpt :: [String] -> [String] 79sortOpt = sortOn $ dropPrefix "NO" 80 81wrapPercent "" = "" 82wrapPercent s = "%%"++ s ++"%%" 83 84dropPercentPrefix = go . T.splitOn (T.pack "%%") 85 where 86 go ((T.null -> True):sub:rest) = go rest 87 go str = T.concat str 88 89-- like stripPrefix, but without Maybe 90stripPrefix' prefix str = case T.stripPrefix prefix str of 91 Just str' -> str' 92 _ -> str 93 94toOptionsDbSubdir :: FilePath -> FilePath 95toOptionsDbSubdir = map slashToUnderscore 96 where 97 slashToUnderscore '/' = '_' 98 slashToUnderscore c = c 99