1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
|
-- Tools.hs
--
-- Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--
-- This file is part of regexpr library
--
-- regexpr is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or any later version.
--
-- regexpr is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANGY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.
module Hidden.Tools (
isSymbol
, modifyFst
, modifySnd
, first
, second
, third
, modifyFirst
, modifySecond
, modifyThird
, guardEqual
, (|||)
, (&&&)
, isBit7On
-- , bifurcate
-- , cat2funcL
, skipRet
, (>..>)
, ignoreCase
, ifM
, applyIf
, headOrErr
) where
import Data.Char ( ord, toUpper, toLower )
import Data.Bits ( (.&.), shiftL )
import Control.Monad ( MonadPlus, guard )
isSymbol :: Char -> Bool
isSymbol = flip elem "!\"#$%&'()*+,-./:;<=>?@[\\]^_'{|}~"
modifyFst :: (a -> c) -> (a, b) -> (c, b)
modifyFst f (x, y) = (f x, y)
modifySnd :: (b -> c) -> (a, b) -> (a, c)
modifySnd f (x, y) = (x, f y)
guardEqual :: (MonadPlus m, Eq a) => m a -> m a -> m ()
guardEqual m1 m2 = do { x <- m1; y <- m2; guard (x == y) }
first :: (a, b, c) -> a
first (x, _, _) = x
second :: (a, b, c) -> b
second (_, y, _) = y
third :: (a, b, c) -> c
third (_, _, z) = z
modifyFirst :: (a -> d) -> (a, b, c) -> (d, b, c)
modifyFirst f (x, y, z) = (f x, y, z)
modifySecond :: (b -> d) -> (a, b, c) -> (a, d, c)
modifySecond f (x, y, z) = (x, f y, z)
modifyThird :: (c -> d) -> (a, b, c) -> (a, b, d)
modifyThird f (x, y, z) = (x, y, f z)
(|||),(&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
(p1 ||| p2) x = p1 x || p2 x
(p1 &&& p2) x = p1 x && p2 x
isBit7On :: Char -> Bool
isBit7On c = ord c .&. shiftL 1 7 /= 0
{-
bifurcate :: (a -> a -> b) -> a -> b
bifurcate f x = f x x
cat2funcL :: (a -> c) -> (b -> c) -> a -> b -> [c]
cat2funcL f g x y = [f x, g y ]
-}
skipRet :: Monad m => m b -> a -> m a
skipRet p x = p >> return x
(>..>) :: Monad m => m a -> m b -> m (a, b)
m1 >..> m2 = do { x <- m1; y <- m2; return (x, y) }
ignoreCase :: (Char -> Bool) -> Char -> Bool
ignoreCase p c = p (toLower c) || p (toUpper c)
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM p mt me = do b <- p
if b then mt
else me
applyIf :: Bool -> (a -> a) -> a -> a
applyIf True f = f
applyIf False _ = id
headOrErr :: String -> [a] -> a
headOrErr err [] = error err
headOrErr _ (x:_) = x
|