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