-- 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 :: Char -> Bool
isSymbol = (Char -> [Char] -> Bool) -> [Char] -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem "!\"#$%&'()*+,-./:;<=>?@[\\]^_'{|}~"

modifyFst :: (a -> c) -> (a, b) -> (c, b)
modifyFst :: (a -> c) -> (a, b) -> (c, b)
modifyFst f :: a -> c
f (x :: a
x, y :: b
y) = (a -> c
f a
x, b
y)
modifySnd :: (b -> c) -> (a, b) -> (a, c)
modifySnd :: (b -> c) -> (a, b) -> (a, c)
modifySnd f :: b -> c
f (x :: a
x, y :: b
y) = (a
x, b -> c
f b
y)

guardEqual :: (MonadPlus m, Eq a) => m a -> m a -> m ()
guardEqual :: m a -> m a -> m ()
guardEqual m1 :: m a
m1 m2 :: m a
m2 = do { a
x <- m a
m1; a
y <- m a
m2; Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y) }

first  :: (a, b, c) -> a
first :: (a, b, c) -> a
first  (x :: a
x, _, _) = a
x
second :: (a, b, c) -> b
second :: (a, b, c) -> b
second (_, y :: b
y, _) = b
y
third  :: (a, b, c) -> c
third :: (a, b, c) -> c
third  (_, _, z :: c
z) = c
z

modifyFirst  :: (a -> d) -> (a, b, c) -> (d, b, c)
modifyFirst :: (a -> d) -> (a, b, c) -> (d, b, c)
modifyFirst  f :: a -> d
f (x :: a
x, y :: b
y, z :: c
z) = (a -> d
f a
x, b
y, c
z)
modifySecond :: (b -> d) -> (a, b, c) -> (a, d, c)
modifySecond :: (b -> d) -> (a, b, c) -> (a, d, c)
modifySecond f :: b -> d
f (x :: a
x, y :: b
y, z :: c
z) = (a
x, b -> d
f b
y, c
z)
modifyThird  :: (c -> d) -> (a, b, c) -> (a, b, d)
modifyThird :: (c -> d) -> (a, b, c) -> (a, b, d)
modifyThird  f :: c -> d
f (x :: a
x, y :: b
y, z :: c
z) = (a
x, b
y, c -> d
f c
z)

(|||),(&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
(p1 :: a -> Bool
p1 ||| :: (a -> Bool) -> (a -> Bool) -> a -> Bool
||| p2 :: a -> Bool
p2) x :: a
x = a -> Bool
p1 a
x Bool -> Bool -> Bool
|| a -> Bool
p2 a
x
(p1 :: a -> Bool
p1 &&& :: (a -> Bool) -> (a -> Bool) -> a -> Bool
&&& p2 :: a -> Bool
p2) x :: a
x = a -> Bool
p1 a
x Bool -> Bool -> Bool
&& a -> Bool
p2 a
x

isBit7On :: Char -> Bool
isBit7On :: Char -> Bool
isBit7On c :: Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL 1 7 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 :: m b -> a -> m a
skipRet p :: m b
p x :: a
x = m b
p m b -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

(>..>) :: Monad m => m a -> m b -> m (a, b)
m1 :: m a
m1 >..> :: m a -> m b -> m (a, b)
>..> m2 :: m b
m2 = do { a
x <- m a
m1; b
y <- m b
m2; (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y) }

ignoreCase :: (Char -> Bool) -> Char -> Bool
ignoreCase :: (Char -> Bool) -> Char -> Bool
ignoreCase p :: Char -> Bool
p c :: Char
c = Char -> Bool
p (Char -> Char
toLower Char
c) Bool -> Bool -> Bool
|| Char -> Bool
p (Char -> Char
toUpper Char
c)

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM p :: m Bool
p mt :: m a
mt me :: m a
me = do Bool
b <- m Bool
p
                 if Bool
b then m a
mt
		      else m a
me

applyIf :: Bool -> (a -> a) -> a -> a
applyIf :: Bool -> (a -> a) -> a -> a
applyIf True f :: a -> a
f  = a -> a
f
applyIf False _ = a -> a
forall a. a -> a
id

headOrErr :: String -> [a] -> a
headOrErr :: [Char] -> [a] -> a
headOrErr err :: [Char]
err []    = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
err
headOrErr _   (x :: a
x:_) = a
x