{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# OPTIONS_GHC -Wno-x-partial #-}

module Language.Haskell.Liquid.Misc where

import Prelude hiding (error)
import Control.Monad.State

import Control.Arrow (first)
import System.Directory   (getModificationTime, doesFileExist)

import qualified Control.Exception     as Ex --(evaluate, catch, IOException)
import qualified Data.HashSet          as S
import qualified Data.HashMap.Strict   as M
import qualified Data.List             as L
import           Data.Maybe
import           Data.Tuple
import           Data.Hashable
import           Data.Time
import           Data.Function (on)
import qualified Data.ByteString       as B
import           Data.ByteString.Char8 (pack, unpack)
import qualified Text.PrettyPrint.HughesPJ as PJ -- (char, Doc)
import           Text.Printf
import           Language.Fixpoint.Misc

type Nat = Int

(.&&.), (.||.) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
.&&. :: forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
(.&&.) = (Bool -> Bool -> Bool) -> (a -> Bool) -> (a -> Bool) -> a -> Bool
forall b c d a. (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d
up Bool -> Bool -> Bool
(&&)
.||. :: forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
(.||.) = (Bool -> Bool -> Bool) -> (a -> Bool) -> (a -> Bool) -> a -> Bool
forall b c d a. (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d
up Bool -> Bool -> Bool
(||)

up :: (b -> c -> d) -> (a -> b) -> (a -> c) -> (a -> d)
up :: forall b c d a. (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d
up b -> c -> d
o a -> b
f a -> c
g a
x = a -> b
f a
x b -> c -> d
`o` a -> c
g a
x

timedAction :: (Show msg) => Maybe msg -> IO a -> IO a
timedAction :: forall msg a. Show msg => Maybe msg -> IO a -> IO a
timedAction Maybe msg
label IO a
io = do
  t0 <- IO UTCTime
getCurrentTime
  a <- io
  t1 <- getCurrentTime
  let time = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime
t1 UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
t0) :: Double
  case label of
    Just msg
x  -> String -> Double -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"Time (%.2fs) for action %s \n" Double
time (msg -> String
forall a. Show a => a -> String
show msg
x)
    Maybe msg
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  return a

(!?) :: [a] -> Int -> Maybe a
[]     !? :: forall a. [a] -> Int -> Maybe a
!? Int
_ = Maybe a
forall a. Maybe a
Nothing
(a
x:[a]
_)  !? Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
(a
_:[a]
xs) !? Int
n = [a]
xs [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
!? (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

safeFromJust :: String -> Maybe t -> t
safeFromJust :: forall t. String -> Maybe t -> t
safeFromJust String
_  (Just t
x) = t
x
safeFromJust String
err Maybe t
_       = String -> t
forall a. (?callStack::CallStack) => String -> a
errorstar String
err

safeFromLeft :: String -> Either a b -> a
safeFromLeft :: forall a b. String -> Either a b -> a
safeFromLeft String
_   (Left a
l) = a
l
safeFromLeft String
err Either a b
_        = String -> a
forall a. (?callStack::CallStack) => String -> a
errorstar String
err


takeLast :: Int -> [a] -> [a]
takeLast :: forall a. Int -> [a] -> [a]
takeLast Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
xs
  where
    m :: Int
m         = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs

getNth :: Int -> [a] -> Maybe a
getNth :: forall a. Int -> [a] -> Maybe a
getNth Int
0 (a
x:[a]
_)  = a -> Maybe a
forall a. a -> Maybe a
Just a
x
getNth Int
n (a
_:[a]
xs) = Int -> [a] -> Maybe a
forall a. Int -> [a] -> Maybe a
getNth (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs
getNth Int
_ [a]
_      = Maybe a
forall a. Maybe a
Nothing

fst4 :: (t, t1, t2, t3) -> t
fst4 :: forall t t1 t2 t3. (t, t1, t2, t3) -> t
fst4 (t
a,t1
_,t2
_,t3
_) = t
a

snd4 :: (t, t1, t2, t3) -> t1
snd4 :: forall t t1 t2 t3. (t, t1, t2, t3) -> t1
snd4 (t
_,t1
b,t2
_,t3
_) = t1
b

thd4 :: (t1, t2, t3, t4) -> t3
thd4 :: forall t1 t2 t3 t4. (t1, t2, t3, t4) -> t3
thd4 (t1
_,t2
_,t3
b,t4
_) = t3
b


thrd3 :: (t1, t2, t3) -> t3
thrd3 :: forall t1 t2 t3. (t1, t2, t3) -> t3
thrd3 (t1
_,t2
_,t3
c) = t3
c

mapFifth5 :: (t -> t4) -> (t0, t1, t2, t3, t) -> (t0, t1, t2, t3, t4)
mapFifth5 :: forall t t4 t0 t1 t2 t3.
(t -> t4) -> (t0, t1, t2, t3, t) -> (t0, t1, t2, t3, t4)
mapFifth5 t -> t4
f (t0
a, t1
x, t2
y, t3
z, t
w) = (t0
a, t1
x, t2
y, t3
z, t -> t4
f t
w)

mapFourth4 :: (t -> t4) -> (t1, t2, t3, t) -> (t1, t2, t3, t4)
mapFourth4 :: forall t t4 t1 t2 t3.
(t -> t4) -> (t1, t2, t3, t) -> (t1, t2, t3, t4)
mapFourth4 t -> t4
f (t1
x, t2
y, t3
z, t
w) = (t1
x, t2
y, t3
z, t -> t4
f t
w)

addFst3 :: t -> (t1, t2) -> (t, t1, t2)
addFst3 :: forall t t1 t2. t -> (t1, t2) -> (t, t1, t2)
addFst3   t
a (t1
b, t2
c) = (t
a, t1
b, t2
c)

addThd3 :: t2 -> (t, t1) -> (t, t1, t2)
addThd3 :: forall t2 t t1. t2 -> (t, t1) -> (t, t1, t2)
addThd3   t2
c (t
a, t1
b) = (t
a, t1
b, t2
c)

dropFst3 :: (t, t1, t2) -> (t1, t2)
dropFst3 :: forall t t1 t2. (t, t1, t2) -> (t1, t2)
dropFst3 (t
_, t1
x, t2
y) = (t1
x, t2
y)

dropThd3 :: (t1, t2, t) -> (t1, t2)
dropThd3 :: forall t1 t2 t. (t1, t2, t) -> (t1, t2)
dropThd3 (t1
x, t2
y, t
_) = (t1
x, t2
y)

replaceN :: (Enum a, Eq a, Num a) => a -> t -> [t] -> [t]
replaceN :: forall a t. (Enum a, Eq a, Num a) => a -> t -> [t] -> [t]
replaceN a
n t
y [t]
ls = [if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n then t
y else t
x | (t
x, a
i) <- [t] -> [a] -> [(t, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [t]
ls [a
0..]]


thd5 :: (t0, t1, t2, t3, t4) -> t2
thd5 :: forall t0 t1 t2 t3 t4. (t0, t1, t2, t3, t4) -> t2
thd5 (t0
_,t1
_,t2
x,t3
_,t4
_) = t2
x

snd5 :: (t0, t1, t2, t3, t4) -> t1
snd5 :: forall t0 t1 t2 t3 t4. (t0, t1, t2, t3, t4) -> t1
snd5 (t0
_,t1
x,t2
_,t3
_,t4
_) = t1
x

fst5 :: (t0, t1, t2, t3, t4) -> t0
fst5 :: forall t0 t1 t2 t3 t4. (t0, t1, t2, t3, t4) -> t0
fst5 (t0
x,t1
_,t2
_,t3
_,t4
_) = t0
x

fourth4 :: (t, t1, t2, t3) -> t3
fourth4 :: forall t t1 t2 t3. (t, t1, t2, t3) -> t3
fourth4 (t
_,t1
_,t2
_,t3
x) = t3
x

third4 :: (t, t1, t2, t3) -> t2
third4 :: forall t1 t2 t3 t4. (t1, t2, t3, t4) -> t3
third4  (t
_,t1
_,t2
x,t3
_) = t2
x

firstM :: Functor f => (t -> f a) -> (t, t1) -> f (a, t1)
firstM :: forall (f :: * -> *) t a t1.
Functor f =>
(t -> f a) -> (t, t1) -> f (a, t1)
firstM  t -> f a
f (t
a,t1
b) = (,t1
b) (a -> (a, t1)) -> f a -> f (a, t1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
a

secondM :: Functor f => (t -> f a) -> (t1, t) -> f (t1, a)
secondM :: forall (f :: * -> *) t a t1.
Functor f =>
(t -> f a) -> (t1, t) -> f (t1, a)
secondM t -> f a
f (t1
a,t
b) = (t1
a,) (a -> (t1, a)) -> f a -> f (t1, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
b

first3M :: Functor f => (t -> f a) -> (t, t1, t2) -> f (a, t1, t2)
first3M :: forall (f :: * -> *) t a t1 t2.
Functor f =>
(t -> f a) -> (t, t1, t2) -> f (a, t1, t2)
first3M  t -> f a
f (t
a,t1
b,t2
c) = (,t1
b,t2
c) (a -> (a, t1, t2)) -> f a -> f (a, t1, t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
a

second3M :: Functor f => (t -> f a) -> (t1, t, t2) -> f (t1, a, t2)
second3M :: forall (f :: * -> *) t a t1 t2.
Functor f =>
(t -> f a) -> (t1, t, t2) -> f (t1, a, t2)
second3M t -> f a
f (t1
a,t
b,t2
c) = (t1
a,,t2
c) (a -> (t1, a, t2)) -> f a -> f (t1, a, t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
b

third3M :: Functor f => (t -> f a) -> (t1, t2, t) -> f (t1, t2, a)
third3M :: forall (f :: * -> *) t a t1 t2.
Functor f =>
(t -> f a) -> (t1, t2, t) -> f (t1, t2, a)
third3M  t -> f a
f (t1
a,t2
b,t
c) = (t1
a,t2
b,) (a -> (t1, t2, a)) -> f a -> f (t1, t2, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
c

third3 :: (t -> t3) -> (t1, t2, t) -> (t1, t2, t3)
third3 :: forall t t3 t1 t2. (t -> t3) -> (t1, t2, t) -> (t1, t2, t3)
third3 t -> t3
f (t1
a,t2
b,t
c) = (t1
a,t2
b,t -> t3
f t
c)

zip4 :: [t] -> [t1] -> [t2] -> [t3] -> [(t, t1, t2, t3)]
zip4 :: forall t t1 t2 t3. [t] -> [t1] -> [t2] -> [t3] -> [(t, t1, t2, t3)]
zip4 (t
x1:[t]
xs1) (t1
x2:[t1]
xs2) (t2
x3:[t2]
xs3) (t3
x4:[t3]
xs4) = (t
x1, t1
x2, t2
x3, t3
x4) (t, t1, t2, t3) -> [(t, t1, t2, t3)] -> [(t, t1, t2, t3)]
forall a. a -> [a] -> [a]
: [t] -> [t1] -> [t2] -> [t3] -> [(t, t1, t2, t3)]
forall t t1 t2 t3. [t] -> [t1] -> [t2] -> [t3] -> [(t, t1, t2, t3)]
zip4 [t]
xs1 [t1]
xs2 [t2]
xs3 [t3]
xs4
zip4 [t]
_ [t1]
_ [t2]
_ [t3]
_                             = []

zip5 :: [t] -> [t1] -> [t2] -> [t3] -> [t4] -> [(t, t1, t2, t3, t4)]
zip5 :: forall t t1 t2 t3 t4.
[t] -> [t1] -> [t2] -> [t3] -> [t4] -> [(t, t1, t2, t3, t4)]
zip5 (t
x1:[t]
xs1) (t1
x2:[t1]
xs2) (t2
x3:[t2]
xs3) (t3
x4:[t3]
xs4) (t4
x5:[t4]
xs5) = (t
x1, t1
x2, t2
x3, t3
x4,t4
x5) (t, t1, t2, t3, t4)
-> [(t, t1, t2, t3, t4)] -> [(t, t1, t2, t3, t4)]
forall a. a -> [a] -> [a]
: [t] -> [t1] -> [t2] -> [t3] -> [t4] -> [(t, t1, t2, t3, t4)]
forall t t1 t2 t3 t4.
[t] -> [t1] -> [t2] -> [t3] -> [t4] -> [(t, t1, t2, t3, t4)]
zip5 [t]
xs1 [t1]
xs2 [t2]
xs3 [t3]
xs4 [t4]
xs5
zip5 [t]
_ [t1]
_ [t2]
_ [t3]
_ [t4]
_                                    = []



unzip4 :: [(t, t1, t2, t3)] -> ([t],[t1],[t2],[t3])
unzip4 :: forall t t1 t2 t3. [(t, t1, t2, t3)] -> ([t], [t1], [t2], [t3])
unzip4 = [t]
-> [t1]
-> [t2]
-> [t3]
-> [(t, t1, t2, t3)]
-> ([t], [t1], [t2], [t3])
forall {a} {a} {a} {a}.
[a] -> [a] -> [a] -> [a] -> [(a, a, a, a)] -> ([a], [a], [a], [a])
go [] [] [] []
  where go :: [a] -> [a] -> [a] -> [a] -> [(a, a, a, a)] -> ([a], [a], [a], [a])
go [a]
a1 [a]
a2 [a]
a3 [a]
a4 ((a
x1,a
x2,a
x3,a
x4):[(a, a, a, a)]
xs) = [a] -> [a] -> [a] -> [a] -> [(a, a, a, a)] -> ([a], [a], [a], [a])
go (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a1) (a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a2) (a
x3a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a3) (a
x4a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a4) [(a, a, a, a)]
xs
        go [a]
a1 [a]
a2 [a]
a3 [a]
a4 [] = ([a] -> [a]
forall a. [a] -> [a]
reverse  [a]
a1, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
a2, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
a3, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
a4)

{-@ type ListN a N = {v:[a] | len v = N} @-}
{-@ type ListL a L = ListN a (len L) @-}

zipMaybe :: [a] -> [b] -> Maybe [(a, b)]
zipMaybe :: forall a b. [a] -> [b] -> Maybe [(a, b)]
zipMaybe [a]
xs [b]
ys
  | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
ys = [(a, b)] -> Maybe [(a, b)]
forall a. a -> Maybe a
Just ([a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [b]
ys)
  | Bool
otherwise              = Maybe [(a, b)]
forall a. Maybe a
Nothing

{-@ safeZipWithError :: _ -> xs:[a] -> ListL b xs -> ListL (a,b) xs / [xs] @-}
safeZipWithError :: String -> [t] -> [t1] -> [(t, t1)]
safeZipWithError :: forall t t1. String -> [t] -> [t1] -> [(t, t1)]
safeZipWithError String
msg (t
x:[t]
xs) (t1
y:[t1]
ys) = (t
x,t1
y) (t, t1) -> [(t, t1)] -> [(t, t1)]
forall a. a -> [a] -> [a]
: String -> [t] -> [t1] -> [(t, t1)]
forall t t1. String -> [t] -> [t1] -> [(t, t1)]
safeZipWithError String
msg [t]
xs [t1]
ys
safeZipWithError String
_   []     []     = []
safeZipWithError String
msg [t]
_      [t1]
_      = String -> [(t, t1)]
forall a. (?callStack::CallStack) => String -> a
errorstar String
msg

safeZip3WithError :: String -> [t] -> [t1] -> [t2] -> [(t, t1, t2)]
safeZip3WithError :: forall t t1 t2. String -> [t] -> [t1] -> [t2] -> [(t, t1, t2)]
safeZip3WithError String
msg (t
x:[t]
xs) (t1
y:[t1]
ys) (t2
z:[t2]
zs) = (t
x,t1
y,t2
z) (t, t1, t2) -> [(t, t1, t2)] -> [(t, t1, t2)]
forall a. a -> [a] -> [a]
: String -> [t] -> [t1] -> [t2] -> [(t, t1, t2)]
forall t t1 t2. String -> [t] -> [t1] -> [t2] -> [(t, t1, t2)]
safeZip3WithError String
msg [t]
xs [t1]
ys [t2]
zs
safeZip3WithError String
_   []     []     []     = []
safeZip3WithError String
msg [t]
_      [t1]
_      [t2]
_      = String -> [(t, t1, t2)]
forall a. (?callStack::CallStack) => String -> a
errorstar String
msg

safeZip4WithError :: String -> [t1] -> [t2] -> [t3] -> [t4] -> [(t1, t2, t3, t4)]
safeZip4WithError :: forall t1 t2 t3 t4.
String -> [t1] -> [t2] -> [t3] -> [t4] -> [(t1, t2, t3, t4)]
safeZip4WithError String
msg (t1
x:[t1]
xs) (t2
y:[t2]
ys) (t3
z:[t3]
zs) (t4
w:[t4]
ws) = (t1
x,t2
y,t3
z,t4
w) (t1, t2, t3, t4) -> [(t1, t2, t3, t4)] -> [(t1, t2, t3, t4)]
forall a. a -> [a] -> [a]
: String -> [t1] -> [t2] -> [t3] -> [t4] -> [(t1, t2, t3, t4)]
forall t1 t2 t3 t4.
String -> [t1] -> [t2] -> [t3] -> [t4] -> [(t1, t2, t3, t4)]
safeZip4WithError String
msg [t1]
xs [t2]
ys [t3]
zs [t4]
ws
safeZip4WithError String
_   []     []     []     []     = []
safeZip4WithError String
msg [t1]
_      [t2]
_      [t3]
_      [t4]
_      = String -> [(t1, t2, t3, t4)]
forall a. (?callStack::CallStack) => String -> a
errorstar String
msg


mapNs :: (Eq a, Num a, Foldable t) => t a -> (a1 -> a1) -> [a1] -> [a1]
mapNs :: forall a (t :: * -> *) a1.
(Eq a, Num a, Foldable t) =>
t a -> (a1 -> a1) -> [a1] -> [a1]
mapNs t a
ns a1 -> a1
f [a1]
xs = ([a1] -> a -> [a1]) -> [a1] -> t a -> [a1]
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[a1]
ys a
n -> a -> (a1 -> a1) -> [a1] -> [a1]
forall a a1. (Eq a, Num a) => a -> (a1 -> a1) -> [a1] -> [a1]
mapN a
n a1 -> a1
f [a1]
ys) [a1]
xs t a
ns

mapN :: (Eq a, Num a) => a -> (a1 -> a1) -> [a1] -> [a1]
mapN :: forall a a1. (Eq a, Num a) => a -> (a1 -> a1) -> [a1] -> [a1]
mapN a
0 a1 -> a1
f (a1
x:[a1]
xs) = a1 -> a1
f a1
x a1 -> [a1] -> [a1]
forall a. a -> [a] -> [a]
: [a1]
xs
mapN a
n a1 -> a1
f (a1
x:[a1]
xs) = a1
x a1 -> [a1] -> [a1]
forall a. a -> [a] -> [a]
: a -> (a1 -> a1) -> [a1] -> [a1]
forall a a1. (Eq a, Num a) => a -> (a1 -> a1) -> [a1] -> [a1]
mapN (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) a1 -> a1
f [a1]
xs
mapN a
_ a1 -> a1
_ []     = []

zipWithDefM :: Monad m => (a -> a -> m a) -> [a] -> [a] -> m [a]
zipWithDefM :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> [a] -> [a] -> m [a]
zipWithDefM a -> a -> m a
_ []     []     = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
zipWithDefM a -> a -> m a
_ [a]
xs     []     = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
zipWithDefM a -> a -> m a
_ []     [a]
ys     = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
ys
zipWithDefM a -> a -> m a
f (a
x:[a]
xs) (a
y:[a]
ys) = (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> m a
f a
x a
y m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> a -> m a) -> [a] -> [a] -> m [a]
forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> [a] -> [a] -> m [a]
zipWithDefM a -> a -> m a
f [a]
xs [a]
ys

zipWithDef :: (a -> a -> a) -> [a] -> [a] -> [a]
zipWithDef :: forall a. (a -> a -> a) -> [a] -> [a] -> [a]
zipWithDef a -> a -> a
_ []     []     = []
zipWithDef a -> a -> a
_ [a]
xs     []     = [a]
xs
zipWithDef a -> a -> a
_ []     [a]
ys     = [a]
ys
zipWithDef a -> a -> a
f (a
x:[a]
xs) (a
y:[a]
ys) = a -> a -> a
f a
x a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a] -> [a]
zipWithDef a -> a -> a
f [a]
xs [a]
ys


foldMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b
foldMapM :: forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM a -> m b
f f a
xs = (a -> (b -> m b) -> b -> m b) -> (b -> m b) -> f a -> b -> m b
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (b -> m b) -> b -> m b
forall {b}. a -> (b -> m b) -> b -> m b
step b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return f a
xs b
forall a. Monoid a => a
mempty
  where
    step :: a -> (b -> m b) -> b -> m b
step a
x b -> m b
r b
z = a -> m b
f a
x m b -> (b -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
y -> b -> m b
r (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! b
z b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` b
y

--------------------------------------------------------------------------------
-- Originally part of Fixpoint's Misc:
--------------------------------------------------------------------------------

single :: t -> [t]
single :: forall t. t -> [t]
single t
x = [t
x]

mapFst3 :: (t -> t1) -> (t, t2, t3) -> (t1, t2, t3)
mapFst3 :: forall t t1 t2 t3. (t -> t1) -> (t, t2, t3) -> (t1, t2, t3)
mapFst3 t -> t1
f (t
x, t2
y, t3
z) = (t -> t1
f t
x, t2
y, t3
z)

mapThd3 :: (t -> t3) -> (t1, t2, t) -> (t1, t2, t3)
mapThd3 :: forall t t3 t1 t2. (t -> t3) -> (t1, t2, t) -> (t1, t2, t3)
mapThd3 t -> t3
f (t1
x, t2
y, t
z) = (t1
x, t2
y, t -> t3
f t
z)

hashMapMapWithKey   :: (k -> v1 -> v2) -> M.HashMap k v1 -> M.HashMap k v2
hashMapMapWithKey :: forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
hashMapMapWithKey k -> v1 -> v2
f = Maybe (HashMap k v2) -> HashMap k v2
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe (HashMap k v2) -> HashMap k v2)
-> (HashMap k v1 -> Maybe (HashMap k v2))
-> HashMap k v1
-> HashMap k v2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> v1 -> Maybe v2) -> HashMap k v1 -> Maybe (HashMap k v2)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
M.traverseWithKey (\k
k v1
v -> v2 -> Maybe v2
forall a. a -> Maybe a
Just (k -> v1 -> v2
f k
k v1
v))

hashMapMapKeys   :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.HashMap k1 v -> M.HashMap k2 v
hashMapMapKeys :: forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
hashMapMapKeys k1 -> k2
f = [(k2, v)] -> HashMap k2 v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(k2, v)] -> HashMap k2 v)
-> (HashMap k1 v -> [(k2, v)]) -> HashMap k1 v -> HashMap k2 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k1, v) -> (k2, v)) -> [(k1, v)] -> [(k2, v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k1 -> k2) -> (k1, v) -> (k2, v)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first k1 -> k2
f) ([(k1, v)] -> [(k2, v)])
-> (HashMap k1 v -> [(k1, v)]) -> HashMap k1 v -> [(k2, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k1 v -> [(k1, v)]
forall k v. HashMap k v -> [(k, v)]
M.toList

concatMapM :: (Monad m, Traversable t) => (a -> m [b]) -> t a -> m [b]
concatMapM :: forall (m :: * -> *) (t :: * -> *) a b.
(Monad m, Traversable t) =>
(a -> m [b]) -> t a -> m [b]
concatMapM a -> m [b]
f = (t [b] -> [b]) -> m (t [b]) -> m [b]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t [b] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m (t [b]) -> m [b]) -> (t a -> m (t [b])) -> t a -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m [b]) -> t a -> m (t [b])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f

replaceSubset :: (Eq k, Hashable k) => [(k, a)] -> [(k, a)] -> [(k, a)]
replaceSubset :: forall k a. (Eq k, Hashable k) => [(k, a)] -> [(k, a)] -> [(k, a)]
replaceSubset [(k, a)]
kvs [(k, a)]
kvs' = HashMap k a -> [(k, a)]
forall k v. HashMap k v -> [(k, v)]
M.toList ((HashMap k a -> (k, a) -> HashMap k a)
-> HashMap k a -> [(k, a)] -> HashMap k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' HashMap k a -> (k, a) -> HashMap k a
forall {k} {v}. Hashable k => HashMap k v -> (k, v) -> HashMap k v
upd HashMap k a
m0 [(k, a)]
kvs')
  where
    m0 :: HashMap k a
m0                = [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(k, a)]
kvs
    upd :: HashMap k v -> (k, v) -> HashMap k v
upd HashMap k v
m (k
k, v
v')
      | k -> HashMap k v -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
M.member k
k HashMap k v
m  = k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert k
k v
v' HashMap k v
m
      | Bool
otherwise     = HashMap k v
m

replaceWith :: (Eq a, Hashable a) => (b -> a) -> [b] -> [b] -> [b]
replaceWith :: forall a b. (Eq a, Hashable a) => (b -> a) -> [b] -> [b] -> [b]
replaceWith b -> a
f [b]
xs [b]
ys = (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> [(a, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)] -> [(a, b)] -> [(a, b)]
forall k a. (Eq k, Hashable k) => [(k, a)] -> [(k, a)] -> [(k, a)]
replaceSubset [(a, b)]
xs' [(a, b)]
ys'
  where
    xs' :: [(a, b)]
xs'             = [ (b -> a
f b
x, b
x) | b
x <- [b]
xs ]
    ys' :: [(a, b)]
ys'             = [ (b -> a
f b
y, b
y) | b
y <- [b]
ys ]




firstElems ::  [(B.ByteString, B.ByteString)] -> B.ByteString -> Maybe (Int, B.ByteString, (B.ByteString, B.ByteString))
firstElems :: [(ByteString, ByteString)]
-> ByteString -> Maybe (Int, ByteString, (ByteString, ByteString))
firstElems [(ByteString, ByteString)]
seps ByteString
str
  = case [(ByteString, ByteString)]
-> ByteString -> [(Int, ByteString, (ByteString, ByteString))]
forall t.
[(ByteString, t)]
-> ByteString -> [(Int, t, (ByteString, ByteString))]
splitters [(ByteString, ByteString)]
seps ByteString
str of
      [] -> Maybe (Int, ByteString, (ByteString, ByteString))
forall a. Maybe a
Nothing
      [(Int, ByteString, (ByteString, ByteString))]
is -> (Int, ByteString, (ByteString, ByteString))
-> Maybe (Int, ByteString, (ByteString, ByteString))
forall a. a -> Maybe a
Just ((Int, ByteString, (ByteString, ByteString))
 -> Maybe (Int, ByteString, (ByteString, ByteString)))
-> (Int, ByteString, (ByteString, ByteString))
-> Maybe (Int, ByteString, (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ ((Int, ByteString, (ByteString, ByteString))
 -> (Int, ByteString, (ByteString, ByteString)) -> Ordering)
-> [(Int, ByteString, (ByteString, ByteString))]
-> (Int, ByteString, (ByteString, ByteString))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.minimumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, ByteString, (ByteString, ByteString)) -> Int)
-> (Int, ByteString, (ByteString, ByteString))
-> (Int, ByteString, (ByteString, ByteString))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, ByteString, (ByteString, ByteString)) -> Int
forall a b c. (a, b, c) -> a
fst3) [(Int, ByteString, (ByteString, ByteString))]
is

splitters :: [(B.ByteString, t)]
          -> B.ByteString -> [(Int, t, (B.ByteString, B.ByteString))]
splitters :: forall t.
[(ByteString, t)]
-> ByteString -> [(Int, t, (ByteString, ByteString))]
splitters [(ByteString, t)]
seps ByteString
str
  = [(Int
i, t
c', (ByteString, ByteString)
z) | (ByteString
c, t
c') <- [(ByteString, t)]
seps
                , let z :: (ByteString, ByteString)
z   = ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
c ByteString
str
                , let i :: Int
i   = ByteString -> Int
B.length ((ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, ByteString)
z)
                , Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
B.length ByteString
str                 ]

bchopAlts :: [(B.ByteString, B.ByteString)] -> B.ByteString -> [B.ByteString]
bchopAlts :: [(ByteString, ByteString)] -> ByteString -> [ByteString]
bchopAlts [(ByteString, ByteString)]
seps  = ByteString -> [ByteString]
go
  where
    go :: ByteString -> [ByteString]
go  ByteString
s               = [ByteString]
-> ((Int, ByteString, (ByteString, ByteString)) -> [ByteString])
-> Maybe (Int, ByteString, (ByteString, ByteString))
-> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString
s] (Int, ByteString, (ByteString, ByteString)) -> [ByteString]
go' ([(ByteString, ByteString)]
-> ByteString -> Maybe (Int, ByteString, (ByteString, ByteString))
firstElems [(ByteString, ByteString)]
seps ByteString
s)
    go' :: (Int, ByteString, (ByteString, ByteString)) -> [ByteString]
go' (Int
_,ByteString
c',(ByteString
s0, ByteString
s1)) = if ByteString -> Int
B.length ByteString
s2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
s1 then [[ByteString] -> ByteString
B.concat [ByteString
s0,ByteString
s1]] else ByteString
s0 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString
s2' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
go ByteString
s3'
                          where (ByteString
s2, ByteString
s3) = ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
c' ByteString
s1
                                s2' :: ByteString
s2'      = ByteString -> ByteString -> ByteString
B.append ByteString
s2 ByteString
c'
                                s3' :: ByteString
s3'      = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
c') ByteString
s3

chopAlts :: [(String, String)] -> String -> [String]
chopAlts :: [(String, String)] -> String -> [String]
chopAlts [(String, String)]
seps String
str = ByteString -> String
unpack (ByteString -> String) -> [ByteString] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString, ByteString)] -> ByteString -> [ByteString]
bchopAlts [(String -> ByteString
pack String
c, String -> ByteString
pack String
c') | (String
c, String
c') <- [(String, String)]
seps] (String -> ByteString
pack String
str)

sortDiff :: (Ord a) => [a] -> [a] -> [a]
sortDiff :: forall a. Ord a => [a] -> [a] -> [a]
sortDiff [a]
x1s [a]
x2s             = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
go ([a] -> [a]
forall a. Ord a => [a] -> [a]
sortNub [a]
x1s) ([a] -> [a]
forall a. Ord a => [a] -> [a]
sortNub [a]
x2s)
  where
    go :: [a] -> [a] -> [a]
go xs :: [a]
xs@(a
x:[a]
xs') ys :: [a]
ys@(a
y:[a]
ys')
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
y               = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs' [a]
ys
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y               = [a] -> [a] -> [a]
go [a]
xs' [a]
ys'
      | Bool
otherwise            = [a] -> [a] -> [a]
go [a]
xs [a]
ys'
    go [a]
xs []                 = [a]
xs
    go [] [a]
_                  = []

(<->) :: PJ.Doc -> PJ.Doc -> PJ.Doc
Doc
x <-> :: Doc -> Doc -> Doc
<-> Doc
y = Doc
x Doc -> Doc -> Doc
PJ.<> Doc
y

angleBrackets :: PJ.Doc -> PJ.Doc
angleBrackets :: Doc -> Doc
angleBrackets Doc
p = Char -> Doc
PJ.char Char
'<' Doc -> Doc -> Doc
<-> Doc
p Doc -> Doc -> Doc
<-> Char -> Doc
PJ.char Char
'>'

mkGraph :: (Eq a, Eq b, Hashable a, Hashable b) => [(a, b)] -> M.HashMap a (S.HashSet b)
mkGraph :: forall a b.
(Eq a, Eq b, Hashable a, Hashable b) =>
[(a, b)] -> HashMap a (HashSet b)
mkGraph = ([b] -> HashSet b) -> HashMap a [b] -> HashMap a (HashSet b)
forall a b. (a -> b) -> HashMap a a -> HashMap a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> HashSet b
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList (HashMap a [b] -> HashMap a (HashSet b))
-> ([(a, b)] -> HashMap a [b]) -> [(a, b)] -> HashMap a (HashSet b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> HashMap a [b]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k [v]
group

tryIgnore :: String -> IO () -> IO ()
tryIgnore :: String -> IO () -> IO ()
tryIgnore String
s IO ()
a =
  IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Ex.catch IO ()
a ((IOException -> IO ()) -> IO ())
-> (IOException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e -> do
    let err :: String
err = IOException -> String
forall a. Show a => a -> String
show (IOException
e :: Ex.IOException)
    String -> IO ()
writeLoud (String
"Warning: Couldn't do " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


condNull :: Monoid m => Bool -> m -> m
condNull :: forall m. Monoid m => Bool -> m -> m
condNull Bool
c m
xs = if Bool
c then m
xs else m
forall a. Monoid a => a
mempty

firstJust :: (a -> Maybe b) -> [a] -> Maybe b
firstJust :: forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust a -> Maybe b
f [a]
xs = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> [b] -> Maybe b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
xs

intToString :: Int -> String
intToString :: Int -> String
intToString Int
1 = String
"1st"
intToString Int
2 = String
"2nd"
intToString Int
3 = String
"3rd"
intToString Int
n = Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"th"

mapAccumM :: (Monad m, Traversable t) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM :: forall (m :: * -> *) (t :: * -> *) a b c.
(Monad m, Traversable t) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM a -> b -> m (a, c)
f a
acc0 t b
xs =
  (t c, a) -> (a, t c)
forall a b. (a, b) -> (b, a)
swap ((t c, a) -> (a, t c)) -> m (t c, a) -> m (a, t c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT a m (t c) -> a -> m (t c, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((b -> StateT a m c) -> t b -> StateT a m (t c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> m (c, a)) -> StateT a m c
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((a -> m (c, a)) -> StateT a m c)
-> (b -> a -> m (c, a)) -> b -> StateT a m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\b
x a
acc -> (a, c) -> (c, a)
forall a b. (a, b) -> (b, a)
swap ((a, c) -> (c, a)) -> m (a, c) -> m (c, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> b -> m (a, c)
f a
acc b
x)) t b
xs) a
acc0

ifM :: (Monad m) => m Bool -> m b -> m b -> m b
ifM :: forall (m :: * -> *) b. Monad m => m Bool -> m b -> m b -> m b
ifM m Bool
b m b
x m b
y = m Bool
b m Bool -> (Bool -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
z -> if Bool
z then m b
x else m b
y

nubHashOn :: (Eq k, Hashable k) => (a -> k) -> [a] -> [a]
nubHashOn :: forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> [a]
nubHashOn a -> k
f = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. (?callStack::CallStack) => [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k [a] -> [[a]]
forall k v. HashMap k v -> [v]
M.elems (HashMap k [a] -> [[a]]) -> ([a] -> HashMap k [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> [a] -> HashMap k [a]
forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> HashMap k [a]
groupMap a -> k
f

nubHashLast :: (Eq k, Hashable k) => (a -> k) -> [a] -> [a]
nubHashLast :: forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> [a]
nubHashLast a -> k
f [a]
xs = HashMap k a -> [a]
forall k v. HashMap k v -> [v]
M.elems (HashMap k a -> [a]) -> HashMap k a -> [a]
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [ (a -> k
f a
x, a
x) | a
x <- [a]
xs ]

nubHashLastM :: (Eq k, Hashable k, Monad m) => (a -> m k) -> [a] -> m [a]
nubHashLastM :: forall k (m :: * -> *) a.
(Eq k, Hashable k, Monad m) =>
(a -> m k) -> [a] -> m [a]
nubHashLastM a -> m k
f [a]
xs =  HashMap k a -> [a]
forall k v. HashMap k v -> [v]
M.elems (HashMap k a -> [a]) -> ([k] -> HashMap k a) -> [k] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(k, a)] -> HashMap k a)
-> ([k] -> [(k, a)]) -> [k] -> HashMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([k] -> [a] -> [(k, a)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [a]
xs) ([k] -> [a]) -> m [k] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m k) -> [a] -> m [k]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m k
f [a]
xs

uniqueByKey :: (Eq k, Hashable k) => [(k, v)] -> Either (k, [v]) [v]
uniqueByKey :: forall k v. (Eq k, Hashable k) => [(k, v)] -> Either (k, [v]) [v]
uniqueByKey = ((k, [v]) -> Either (k, [v]) v) -> [(k, v)] -> Either (k, [v]) [v]
forall k v e.
(Eq k, Hashable k) =>
((k, [v]) -> Either e v) -> [(k, v)] -> Either e [v]
uniqueByKey' (k, [v]) -> Either (k, [v]) v
forall {a} {b}. (a, [b]) -> Either (a, [b]) b
tx
  where
    tx :: (a, [b]) -> Either (a, [b]) b
tx (a
_, [b
v]) = b -> Either (a, [b]) b
forall a b. b -> Either a b
Right b
v
    tx (a
k, [b]
vs)  = (a, [b]) -> Either (a, [b]) b
forall a b. a -> Either a b
Left  (a
k, [b]
vs)

uniqueByKey' :: (Eq k, Hashable k) => ((k, [v]) -> Either e v) -> [(k, v)] -> Either e [v]
uniqueByKey' :: forall k v e.
(Eq k, Hashable k) =>
((k, [v]) -> Either e v) -> [(k, v)] -> Either e [v]
uniqueByKey' (k, [v]) -> Either e v
tx = ((k, [v]) -> Either e v) -> [(k, [v])] -> Either e [v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (k, [v]) -> Either e v
tx ([(k, [v])] -> Either e [v])
-> ([(k, v)] -> [(k, [v])]) -> [(k, v)] -> Either e [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> [(k, [v])]
forall k v. (Eq k, Hashable k) => [(k, v)] -> [(k, [v])]
groupList


join :: (Eq b, Hashable b) => [(a, b)] -> [(b, c)] -> [(a, c)]
join :: forall b a c.
(Eq b, Hashable b) =>
[(a, b)] -> [(b, c)] -> [(a, c)]
join [(a, b)]
aBs [(b, c)]
bCs = [ (a
a, c
c) | (a
a, b
b) <- [(a, b)]
aBs, c
c <- b -> [c]
b2cs b
b ]
  where
    bM :: HashMap b c
bM       = [(b, c)] -> HashMap b c
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(b, c)]
bCs
    b2cs :: b -> [c]
b2cs b
b   = Maybe c -> [c]
forall a. Maybe a -> [a]
maybeToList (b -> HashMap b c -> Maybe c
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup b
b HashMap b c
bM)


fstByRank :: (Ord r, Hashable k, Eq k) => [(r, k, v)] -> [(r, k, v)]
fstByRank :: forall r k v.
(Ord r, Hashable k, Eq k) =>
[(r, k, v)] -> [(r, k, v)]
fstByRank [(r, k, v)]
rkvs = [ (r
r, k
k, v
v) | (k
k, [(r, v)]
rvs) <- [(k, [(r, v)])]
krvss, let (r
r, v
v) = [(r, v)] -> (r, v)
forall {b}. [(r, b)] -> (r, b)
getFst [(r, v)]
rvs ]
  where
    getFst :: [(r, b)] -> (r, b)
getFst     = [(r, b)] -> (r, b)
forall a. (?callStack::CallStack) => [a] -> a
head ([(r, b)] -> (r, b))
-> ([(r, b)] -> [(r, b)]) -> [(r, b)] -> (r, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r, b) -> r) -> [(r, b)] -> [(r, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (r, b) -> r
forall a b. (a, b) -> a
fst
    krvss :: [(k, [(r, v)])]
krvss      = [(k, (r, v))] -> [(k, [(r, v)])]
forall k v. (Eq k, Hashable k) => [(k, v)] -> [(k, [v])]
groupList [ (k
k, (r
r, v
v)) | (r
r, k
k, v
v) <- [(r, k, v)]
rkvs ]

sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
sortOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn a -> b
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

firstGroup :: (Eq k, Ord k, Hashable k) => [(k, a)] -> [a]
firstGroup :: forall k a. (Eq k, Ord k, Hashable k) => [(k, a)] -> [a]
firstGroup [(k, a)]
kvs = case [(k, a)] -> [(k, [a])]
forall k v. (Eq k, Hashable k) => [(k, v)] -> [(k, [v])]
groupList [(k, a)]
kvs of
  []   -> []
  [(k, [a])]
kvss -> (k, [a]) -> [a]
forall a b. (a, b) -> b
snd ((k, [a]) -> [a]) -> ([(k, [a])] -> (k, [a])) -> [(k, [a])] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, [a])] -> (k, [a])
forall a. (?callStack::CallStack) => [a] -> a
head ([(k, [a])] -> (k, [a]))
-> ([(k, [a])] -> [(k, [a])]) -> [(k, [a])] -> (k, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, [a]) -> k) -> [(k, [a])] -> [(k, [a])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (k, [a]) -> k
forall a b. (a, b) -> a
fst ([(k, [a])] -> [a]) -> [(k, [a])] -> [a]
forall a b. (a -> b) -> a -> b
$ [(k, [a])]
kvss

{- mapEither :: (a -> Either b c) -> [a] -> ([b], [c])
mapEither f []     = ([], [])
mapEither f (x:xs) = case f x of
                       Left y  -> (y:ys, zs)
                       Right z -> (ys, z:zs)
                     where
                       (ys, zs) = mapEither f xs
-}
mapErr :: (a -> Either e b) -> [a] -> Either [e] [b]
mapErr :: forall a e b. (a -> Either e b) -> [a] -> Either [e] [b]
mapErr a -> Either e b
f [a]
xs = [Either e b] -> Either [e] [b]
forall a b. [Either a b] -> Either [a] [b]
catEithers ((a -> Either e b) -> [a] -> [Either e b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either e b
f [a]
xs)

catEithers :: [ Either a b ] -> Either [a] [b]
catEithers :: forall a b. [Either a b] -> Either [a] [b]
catEithers [Either a b]
zs = case [a]
ls of
  [] -> [b] -> Either [a] [b]
forall a b. b -> Either a b
Right [b]
rs
  [a]
_  -> [a] -> Either [a] [b]
forall a b. a -> Either a b
Left [a]
ls
  where
    ls :: [a]
ls = [ a
l | Left  a
l <- [Either a b]
zs ]
    rs :: [b]
rs = [ b
r | Right b
r <- [Either a b]
zs ]


keyDiff :: (Eq k, Hashable k) => (a -> k) -> [a] -> [a] -> [a]
keyDiff :: forall a b. (Eq a, Hashable a) => (b -> a) -> [b] -> [b] -> [b]
keyDiff a -> k
f [a]
x1s [a]
x2s = HashMap k a -> [a]
forall k v. HashMap k v -> [v]
M.elems (HashMap k a -> HashMap k a -> HashMap k a
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
M.difference ([a] -> HashMap k a
m [a]
x1s) ([a] -> HashMap k a
m [a]
x2s))
  where
    m :: [a] -> HashMap k a
m [a]
xs          = [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(a -> k
f a
x, a
x) | a
x <- [a]
xs]

concatUnzip :: [([a], [b])] -> ([a], [b])
concatUnzip :: forall a b. [([a], [b])] -> ([a], [b])
concatUnzip [([a], [b])]
xsyss = ((([a], [b]) -> [a]) -> [([a], [b])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a], [b]) -> [a]
forall a b. (a, b) -> a
fst [([a], [b])]
xsyss, (([a], [b]) -> [b]) -> [([a], [b])] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a], [b]) -> [b]
forall a b. (a, b) -> b
snd [([a], [b])]
xsyss)


sayReadFile :: FilePath -> IO String
sayReadFile :: String -> IO String
sayReadFile String
f = do
  -- print ("SAY-READ-FILE: " ++ f)
  res <- String -> IO String
readFile String
f
  Ex.evaluate res

lastModified :: FilePath -> IO (Maybe UTCTime)
lastModified :: String -> IO (Maybe UTCTime)
lastModified String
f = do
  ex  <- String -> IO Bool
doesFileExist String
f
  if ex then Just <$> getModificationTime f
        else return   Nothing


data Validate e a = Err e | Val a

instance Functor (Validate e) where
  fmap :: forall a b. (a -> b) -> Validate e a -> Validate e b
fmap a -> b
_ (Err e
e) = e -> Validate e b
forall e a. e -> Validate e a
Err e
e
  fmap a -> b
f (Val a
v)  = b -> Validate e b
forall e a. a -> Validate e a
Val (a -> b
f a
v)

instance Monoid e => Applicative (Validate e) where
  pure :: forall a. a -> Validate e a
pure = a -> Validate e a
forall e a. a -> Validate e a
Val
  (Err e
e1) <*> :: forall a b. Validate e (a -> b) -> Validate e a -> Validate e b
<*> Err e
e2 = e -> Validate e b
forall e a. e -> Validate e a
Err (e
e1 e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e2)
  (Err e
e1) <*> Validate e a
_      = e -> Validate e b
forall e a. e -> Validate e a
Err e
e1
  Validate e (a -> b)
_        <*> Err e
e2 = e -> Validate e b
forall e a. e -> Validate e a
Err e
e2
  (Val a -> b
f)  <*> Val a
x  = b -> Validate e b
forall e a. a -> Validate e a
Val (a -> b
f a
x)