module Futhark.Util
( nubOrd,
nubByOrd,
mapAccumLM,
maxinum,
chunk,
chunks,
pairs,
unpairs,
dropAt,
takeLast,
dropLast,
mapEither,
partitionMaybe,
maybeNth,
maybeHead,
splitFromEnd,
splitAt3,
focusNth,
focusMaybe,
hashText,
showText,
unixEnvironment,
isEnvVarAtLeast,
startupTime,
fancyTerminal,
hFancyTerminal,
runProgramWithExitCode,
directoryContents,
fromPOSIX,
toPOSIX,
trim,
pmapIO,
interactWithFileSafely,
convFloat,
UserText,
EncodedText,
zEncodeText,
atMostChars,
invertMap,
cartesian,
traverseFold,
fixPoint,
concatMapM,
)
where
import Control.Arrow (first)
import Control.Concurrent
import Control.Exception
import Control.Monad
import Crypto.Hash.MD5 as MD5
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.Char
import Data.Either
import Data.Foldable (fold, toList)
import Data.Function ((&))
import Data.List (findIndex, foldl', genericDrop, genericSplitAt, sortBy)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Encoding.Error qualified as T
import Data.Time.Clock (UTCTime, getCurrentTime)
import Data.Tuple (swap)
import Numeric
import System.Directory.Tree qualified as Dir
import System.Environment
import System.Exit
import System.FilePath qualified as Native
import System.FilePath.Posix qualified as Posix
import System.IO (Handle, hIsTerminalDevice, stdout)
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe
import System.Process.ByteString
import Text.Read (readMaybe)
nubOrd :: Ord a => [a] -> [a]
nubOrd :: forall a. Ord a => [a] -> [a]
nubOrd = forall a. (a -> a -> Ordering) -> [a] -> [a]
nubByOrd forall a. Ord a => a -> a -> Ordering
compare
nubByOrd :: (a -> a -> Ordering) -> [a] -> [a]
nubByOrd :: forall a. (a -> a -> Ordering) -> [a] -> [a]
nubByOrd a -> a -> Ordering
cmp = forall a b. (a -> b) -> [a] -> [b]
map forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy a -> a -> Bool
eq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp
where
eq :: a -> a -> Bool
eq a
x a
y = a -> a -> Ordering
cmp a
x a
y forall a. Eq a => a -> a -> Bool
== Ordering
EQ
mapAccumLM ::
Monad m =>
(acc -> x -> m (acc, y)) ->
acc ->
[x] ->
m (acc, [y])
mapAccumLM :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
_ acc
acc [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (acc
acc, [])
mapAccumLM acc -> x -> m (acc, y)
f acc
acc (x
x : [x]
xs) = do
(acc
acc', y
x') <- acc -> x -> m (acc, y)
f acc
acc x
x
(acc
acc'', [y]
xs') <- forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
acc' [x]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (acc
acc'', y
x' forall a. a -> [a] -> [a]
: [y]
xs')
chunk :: Int -> [a] -> [[a]]
chunk :: forall a. Int -> [a] -> [[a]]
chunk Int
_ [] = []
chunk Int
n [a]
xs =
let ([a]
bef, [a]
aft) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
in [a]
bef forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [[a]]
chunk Int
n [a]
aft
chunks :: [Int] -> [a] -> [[a]]
chunks :: forall a. [Int] -> [a] -> [[a]]
chunks [] [a]
_ = []
chunks (Int
n : [Int]
ns) [a]
xs =
let ([a]
bef, [a]
aft) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
in [a]
bef forall a. a -> [a] -> [a]
: forall a. [Int] -> [a] -> [[a]]
chunks [Int]
ns [a]
aft
pairs :: [a] -> [(a, a)]
pairs :: forall a. [a] -> [(a, a)]
pairs (a
a : a
b : [a]
l) = (a
a, a
b) forall a. a -> [a] -> [a]
: forall a. [a] -> [(a, a)]
pairs [a]
l
pairs [a]
_ = []
unpairs :: [(a, a)] -> [a]
unpairs :: forall a. [(a, a)] -> [a]
unpairs [] = []
unpairs ((a
a, a
b) : [(a, a)]
l) = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: forall a. [(a, a)] -> [a]
unpairs [(a, a)]
l
maxinum :: (Num a, Ord a, Foldable f) => f a -> a
maxinum :: forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => a -> a -> a
max a
0
dropAt :: Int -> Int -> [a] -> [a]
dropAt :: forall a. Int -> Int -> [a] -> [a]
dropAt Int
i Int
n [a]
xs = forall a. Int -> [a] -> [a]
take Int
i [a]
xs forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (Int
i forall a. Num a => a -> a -> a
+ Int
n) [a]
xs
takeLast :: Int -> [a] -> [a]
takeLast :: forall a. Int -> [a] -> [a]
takeLast Int
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
dropLast :: Int -> [a] -> [a]
dropLast :: forall a. Int -> [a] -> [a]
dropLast Int
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
mapEither :: (a -> Either b c) -> [a] -> ([b], [c])
mapEither :: forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
mapEither a -> Either b c
f [a]
l = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> Either b c
f [a]
l
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe :: forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe a -> Maybe b
f = ([b], [a]) -> [a] -> ([b], [a])
helper ([], [])
where
helper :: ([b], [a]) -> [a] -> ([b], [a])
helper ([b]
acc1, [a]
acc2) [] = (forall a. [a] -> [a]
reverse [b]
acc1, forall a. [a] -> [a]
reverse [a]
acc2)
helper ([b]
acc1, [a]
acc2) (a
x : [a]
xs) =
case a -> Maybe b
f a
x of
Just b
x' -> ([b], [a]) -> [a] -> ([b], [a])
helper (b
x' forall a. a -> [a] -> [a]
: [b]
acc1, [a]
acc2) [a]
xs
Maybe b
Nothing -> ([b], [a]) -> [a] -> ([b], [a])
helper ([b]
acc1, a
x forall a. a -> [a] -> [a]
: [a]
acc2) [a]
xs
maybeNth :: Integral int => int -> [a] -> Maybe a
maybeNth :: forall int a. Integral int => int -> [a] -> Maybe a
maybeNth int
i [a]
l
| int
i forall a. Ord a => a -> a -> Bool
>= int
0, a
v : [a]
_ <- forall i a. Integral i => i -> [a] -> [a]
genericDrop int
i [a]
l = forall a. a -> Maybe a
Just a
v
| Bool
otherwise = forall a. Maybe a
Nothing
maybeHead :: [a] -> Maybe a
maybeHead :: forall a. [a] -> Maybe a
maybeHead [] = forall a. Maybe a
Nothing
maybeHead (a
x : [a]
_) = forall a. a -> Maybe a
Just a
x
splitFromEnd :: Int -> [a] -> ([a], [a])
splitFromEnd :: forall a. Int -> [a] -> ([a], [a])
splitFromEnd Int
i [a]
l = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l forall a. Num a => a -> a -> a
- Int
i) [a]
l
splitAt3 :: Int -> Int -> [a] -> ([a], [a], [a])
splitAt3 :: forall a. Int -> Int -> [a] -> ([a], [a], [a])
splitAt3 Int
n Int
m [a]
l =
let ([a]
xs, [a]
l') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
l
([a]
ys, [a]
zs) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
m [a]
l'
in ([a]
xs, [a]
ys, [a]
zs)
focusNth :: Integral int => int -> [a] -> Maybe ([a], a, [a])
focusNth :: forall int a. Integral int => int -> [a] -> Maybe ([a], a, [a])
focusNth int
i [a]
xs
| ([a]
bef, a
x : [a]
aft) <- forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt int
i [a]
xs = forall a. a -> Maybe a
Just ([a]
bef, a
x, [a]
aft)
| Bool
otherwise = forall a. Maybe a
Nothing
focusMaybe :: (a -> Maybe b) -> [a] -> Maybe ([a], b, [a])
focusMaybe :: forall a b. (a -> Maybe b) -> [a] -> Maybe ([a], b, [a])
focusMaybe a -> Maybe b
f [a]
xs = do
Int
idx <- forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f) [a]
xs
([a]
before, a
focus, [a]
after) <- forall int a. Integral int => int -> [a] -> Maybe ([a], a, [a])
focusNth Int
idx [a]
xs
b
res <- a -> Maybe b
f a
focus
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
before, b
res, [a]
after)
hashText :: T.Text -> T.Text
hashText :: Text -> Text
hashText =
OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
MD5.hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
showText :: Show a => a -> T.Text
showText :: forall a. Show a => a -> Text
showText = UserString -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> UserString
show
{-# NOINLINE unixEnvironment #-}
unixEnvironment :: [(String, String)]
unixEnvironment :: [(UserString, UserString)]
unixEnvironment = forall a. IO a -> a
unsafePerformIO IO [(UserString, UserString)]
getEnvironment
isEnvVarAtLeast :: String -> Int -> Bool
isEnvVarAtLeast :: UserString -> Int -> Bool
isEnvVarAtLeast UserString
s Int
x =
case forall a. Read a => UserString -> Maybe a
readMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup UserString
s [(UserString, UserString)]
unixEnvironment of
Just Int
y -> Int
y forall a. Ord a => a -> a -> Bool
>= Int
x
Maybe Int
_ -> Bool
False
{-# NOINLINE startupTime #-}
startupTime :: UTCTime
startupTime :: UTCTime
startupTime = forall a. IO a -> a
unsafePerformIO IO UTCTime
getCurrentTime
{-# NOINLINE fancyTerminal #-}
fancyTerminal :: Bool
fancyTerminal :: Bool
fancyTerminal = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hFancyTerminal Handle
stdout
hFancyTerminal :: Handle -> IO Bool
hFancyTerminal :: Handle -> IO Bool
hFancyTerminal Handle
h = do
Bool
isTTY <- Handle -> IO Bool
hIsTerminalDevice Handle
h
Bool
isDumb <- (forall a. a -> Maybe a
Just UserString
"dumb" ==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserString -> IO (Maybe UserString)
lookupEnv UserString
"TERM"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
isTTY Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDumb
runProgramWithExitCode ::
FilePath ->
[String] ->
BS.ByteString ->
IO (Either IOException (ExitCode, String, String))
runProgramWithExitCode :: UserString
-> [UserString]
-> ByteString
-> IO (Either IOException (ExitCode, UserString, UserString))
runProgramWithExitCode UserString
exe [UserString]
args ByteString
inp =
(forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}.
(a, ByteString, ByteString) -> (a, UserString, UserString)
postprocess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserString
-> [UserString]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode UserString
exe [UserString]
args ByteString
inp)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left IOException
e)
where
decode :: ByteString -> UserString
decode = Text -> UserString
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode
postprocess :: (a, ByteString, ByteString) -> (a, UserString, UserString)
postprocess (a
code, ByteString
out, ByteString
err) =
(a
code, ByteString -> UserString
decode ByteString
out, ByteString -> UserString
decode ByteString
err)
directoryContents :: FilePath -> IO [FilePath]
directoryContents :: UserString -> IO [UserString]
directoryContents UserString
dir = do
UserString
_ Dir.:/ DirTree UserString
tree <- forall a.
(UserString -> IO a) -> UserString -> IO (AnchoredDirTree a)
Dir.readDirectoryWith forall (f :: * -> *) a. Applicative f => a -> f a
pure UserString
dir
case forall a. DirTree a -> [DirTree a]
Dir.failures DirTree UserString
tree of
Dir.Failed UserString
_ IOException
err : [DirTree UserString]
_ -> forall a e. Exception e => e -> a
throw IOException
err
[DirTree UserString]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. DirTree a -> Maybe a
isFile forall a b. (a -> b) -> a -> b
$ forall a. DirTree a -> [DirTree a]
Dir.flattenDir DirTree UserString
tree
where
isFile :: DirTree a -> Maybe a
isFile (Dir.File UserString
_ a
path) = forall a. a -> Maybe a
Just a
path
isFile DirTree a
_ = forall a. Maybe a
Nothing
toPOSIX :: Native.FilePath -> Posix.FilePath
toPOSIX :: UserString -> UserString
toPOSIX = [UserString] -> UserString
Posix.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserString -> [UserString]
Native.splitDirectories
fromPOSIX :: Posix.FilePath -> Native.FilePath
fromPOSIX :: UserString -> UserString
fromPOSIX = [UserString] -> UserString
Native.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserString -> [UserString]
Posix.splitDirectories
trim :: String -> String
trim :: UserString -> UserString
trim = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
pmapIO :: Maybe Int -> (a -> IO b) -> [a] -> IO [b]
pmapIO :: forall a b. Maybe Int -> (a -> IO b) -> [a] -> IO [b]
pmapIO Maybe Int
concurrency a -> IO b
f [a]
elems = do
MVar [a]
tasks <- forall a. a -> IO (MVar a)
newMVar [a]
elems
MVar (Either SomeException b)
results <- forall a. IO (MVar a)
newEmptyMVar
Int
num_threads <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Int
getNumCapabilities forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
concurrency
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
num_threads forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall {a}. Exception a => MVar [a] -> MVar (Either a b) -> IO ()
worker MVar [a]
tasks MVar (Either SomeException b)
results
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
elems) forall a b. (a -> b) -> a -> b
$ forall {b}. MVar (Either SomeException b) -> IO b
getResult MVar (Either SomeException b)
results
where
worker :: MVar [a] -> MVar (Either a b) -> IO ()
worker MVar [a]
tasks MVar (Either a b)
results = do
Maybe a
task <- forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [a]
tasks forall {f :: * -> *} {a}. Applicative f => [a] -> f ([a], Maybe a)
getTask
case Maybe a
task of
Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just a
x -> do
Either a b
y <- (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO b
f a
x) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
forall a. MVar a -> a -> IO ()
putMVar MVar (Either a b)
results Either a b
y
MVar [a] -> MVar (Either a b) -> IO ()
worker MVar [a]
tasks MVar (Either a b)
results
getTask :: [a] -> f ([a], Maybe a)
getTask [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall a. Maybe a
Nothing)
getTask (a
task : [a]
tasks) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
tasks, forall a. a -> Maybe a
Just a
task)
getResult :: MVar (Either SomeException b) -> IO b
getResult MVar (Either SomeException b)
results = do
Either SomeException b
res <- forall a. MVar a -> IO a
takeMVar MVar (Either SomeException b)
results
case Either SomeException b
res of
Left SomeException
err -> forall a e. Exception e => e -> a
throw (SomeException
err :: SomeException)
Right b
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
interactWithFileSafely :: IO a -> IO (Maybe (Either String a))
interactWithFileSafely :: forall a. IO a -> IO (Maybe (Either UserString a))
interactWithFileSafely IO a
m =
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
m) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall {f :: * -> *} {b}.
Applicative f =>
IOException -> f (Maybe (Either UserString b))
couldNotRead
where
couldNotRead :: IOException -> f (Maybe (Either UserString b))
couldNotRead IOException
e
| IOException -> Bool
isDoesNotExistError IOException
e =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| Bool
otherwise =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> UserString
show IOException
e
convFloat :: (RealFloat from, RealFloat to) => from -> to
convFloat :: forall from to. (RealFloat from, RealFloat to) => from -> to
convFloat from
v
| forall a. RealFloat a => a -> Bool
isInfinite from
v, from
v forall a. Ord a => a -> a -> Bool
> from
0 = to
1 forall a. Fractional a => a -> a -> a
/ to
0
| forall a. RealFloat a => a -> Bool
isInfinite from
v, from
v forall a. Ord a => a -> a -> Bool
< from
0 = -to
1 forall a. Fractional a => a -> a -> a
/ to
0
| forall a. RealFloat a => a -> Bool
isNaN from
v = to
0 forall a. Fractional a => a -> a -> a
/ to
0
| Bool
otherwise = forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational from
v
type UserString = String
type EncodedString = String
zEncodeString :: UserString -> EncodedString
zEncodeString :: UserString -> UserString
zEncodeString UserString
"" = UserString
""
zEncodeString (Char
c : UserString
cs) = Char -> UserString
encodeDigitChar Char
c forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> UserString
encodeChar UserString
cs
type UserText = T.Text
type EncodedText = T.Text
zEncodeText :: UserText -> EncodedText
zEncodeText :: Text -> Text
zEncodeText = UserString -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserString -> UserString
zEncodeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserString
T.unpack
unencodedChar :: Char -> Bool
unencodedChar :: Char -> Bool
unencodedChar Char
'Z' = Bool
False
unencodedChar Char
'z' = Bool
False
unencodedChar Char
'_' = Bool
True
unencodedChar Char
c =
Char -> Bool
isAsciiLower Char
c
Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c
Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c
encodeDigitChar :: Char -> EncodedString
encodeDigitChar :: Char -> UserString
encodeDigitChar Char
c
| Char -> Bool
isDigit Char
c = Char -> UserString
encodeAsUnicodeCharar Char
c
| Bool
otherwise = Char -> UserString
encodeChar Char
c
encodeChar :: Char -> EncodedString
encodeChar :: Char -> UserString
encodeChar Char
c | Char -> Bool
unencodedChar Char
c = [Char
c]
encodeChar Char
'(' = UserString
"ZL"
encodeChar Char
')' = UserString
"ZR"
encodeChar Char
'[' = UserString
"ZM"
encodeChar Char
']' = UserString
"ZN"
encodeChar Char
':' = UserString
"ZC"
encodeChar Char
'Z' = UserString
"ZZ"
encodeChar Char
'z' = UserString
"zz"
encodeChar Char
'&' = UserString
"za"
encodeChar Char
'|' = UserString
"zb"
encodeChar Char
'^' = UserString
"zc"
encodeChar Char
'$' = UserString
"zd"
encodeChar Char
'=' = UserString
"ze"
encodeChar Char
'>' = UserString
"zg"
encodeChar Char
'#' = UserString
"zh"
encodeChar Char
'.' = UserString
"zi"
encodeChar Char
'<' = UserString
"zl"
encodeChar Char
'-' = UserString
"zm"
encodeChar Char
'!' = UserString
"zn"
encodeChar Char
'+' = UserString
"zp"
encodeChar Char
'\'' = UserString
"zq"
encodeChar Char
'\\' = UserString
"zr"
encodeChar Char
'/' = UserString
"zs"
encodeChar Char
'*' = UserString
"zt"
encodeChar Char
'_' = UserString
"zu"
encodeChar Char
'%' = UserString
"zv"
encodeChar Char
c = Char -> UserString
encodeAsUnicodeCharar Char
c
encodeAsUnicodeCharar :: Char -> EncodedString
encodeAsUnicodeCharar :: Char -> UserString
encodeAsUnicodeCharar Char
c =
Char
'z'
forall a. a -> [a] -> [a]
: if Char -> Bool
isDigit (forall a. [a] -> a
head UserString
hex_str)
then UserString
hex_str
else Char
'0' forall a. a -> [a] -> [a]
: UserString
hex_str
where
hex_str :: UserString
hex_str = forall a. (Integral a, Show a) => a -> UserString -> UserString
showHex (Char -> Int
ord Char
c) UserString
"U"
atMostChars :: Int -> T.Text -> T.Text
atMostChars :: Int -> Text -> Text
atMostChars Int
n Text
s
| Text -> Int
T.length Text
s forall a. Ord a => a -> a -> Bool
> Int
n = Int -> Text -> Text
T.take (Int
n forall a. Num a => a -> a -> a
- Int
3) Text
s forall a. Semigroup a => a -> a -> a
<> Text
"..."
| Bool
otherwise = Text
s
invertMap :: (Ord v, Ord k) => M.Map k v -> M.Map v (S.Set k)
invertMap :: forall v k. (Ord v, Ord k) => Map k v -> Map v (Set k)
invertMap Map k v
m =
forall k a. Map k a -> [(k, a)]
M.toList Map k v
m
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. a -> Set a
S.singleton)
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>)) forall a. Monoid a => a
mempty
cartesian :: (Monoid m, Foldable t) => (a -> a -> m) -> t a -> t a -> m
cartesian :: forall m (t :: * -> *) a.
(Monoid m, Foldable t) =>
(a -> a -> m) -> t a -> t a -> m
cartesian a -> a -> m
f t a
xs t a
ys =
[(a
x, a
y) | a
x <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
xs, a
y <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
ys]
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> m
f)
traverseFold :: (Monoid m, Traversable t, Applicative f) => (a -> f m) -> t a -> f m
traverseFold :: forall m (t :: * -> *) (f :: * -> *) a.
(Monoid m, Traversable t, Applicative f) =>
(a -> f m) -> t a -> f m
traverseFold a -> f m
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f m
f
fixPoint :: Eq a => (a -> a) -> a -> a
fixPoint :: forall a. Eq a => (a -> a) -> a -> a
fixPoint a -> a
f a
x =
let x' :: a
x' = a -> a
f a
x
in if a
x' forall a. Eq a => a -> a -> Bool
== a
x then a
x else forall a. Eq a => (a -> a) -> a -> a
fixPoint a -> a
f a
x'
concatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
concatMapM :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
concatMapM a -> m b
f [a]
xs = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f [a]
xs