{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DoAndIfThenElse #-}

module Language.Haskell.Liquid.Misc where

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

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

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
import           Paths_liquidhaskell_boot

type Nat = Int

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

(!?) :: [a] -> Int -> Maybe a
[]     !? :: forall a. [a] -> Int -> Maybe a
!? Int
_ = forall a. Maybe a
Nothing
(a
x:[a]
_)  !? Int
0 = forall a. a -> Maybe a
Just a
x
(a
_:[a]
xs) !? Int
n = [a]
xs forall a. [a] -> Int -> Maybe a
!? (Int
nforall 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
_       = 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
_        = forall a. (?callStack::CallStack) => String -> a
errorstar String
err


takeLast :: Int -> [a] -> [a]
takeLast :: forall a. Int -> [a] -> [a]
takeLast Int
n [a]
xs = forall a. Int -> [a] -> [a]
drop (Int
m forall a. Num a => a -> a -> a
- Int
n) [a]
xs
  where
    m :: Int
m         = 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]
_)  = forall a. a -> Maybe a
Just a
x
getNth Int
n (a
_:[a]
xs) = forall a. Int -> [a] -> Maybe a
getNth (Int
nforall a. Num a => a -> a -> a
-Int
1) [a]
xs
getNth Int
_ [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 forall a. Eq a => a -> a -> Bool
== a
n then t
y else t
x | (t
x, a
i) <- 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

mapSndM :: (Applicative m) => (b -> m c) -> (a, b) -> m (a, c)
-- mapSndM f (x, y) = return . (x,) =<< f y
mapSndM :: forall (m :: * -> *) b c a.
Applicative m =>
(b -> m c) -> (a, b) -> m (a, c)
mapSndM b -> m c
f (a
x, b
y) = (a
x, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m c
f b
y

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) 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,) 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) 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) 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,) 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) forall a. a -> [a] -> [a]
: 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) forall a. a -> [a] -> [a]
: 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 = 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
x1forall a. a -> [a] -> [a]
:[a]
a1) (a
x2forall a. a -> [a] -> [a]
:[a]
a2) (a
x3forall a. a -> [a] -> [a]
:[a]
a3) (a
x4forall a. a -> [a] -> [a]
:[a]
a4) [(a, a, a, a)]
xs
        go [a]
a1 [a]
a2 [a]
a3 [a]
a4 [] = (forall a. [a] -> [a]
reverse  [a]
a1, forall a. [a] -> [a]
reverse [a]
a2, forall a. [a] -> [a]
reverse [a]
a3, forall a. [a] -> [a]
reverse [a]
a4)


getCssPath :: IO FilePath
getCssPath :: IO String
getCssPath         = String -> IO String
getDataFileName forall a b. (a -> b) -> a -> b
$ String
"syntax" String -> String -> String
</> String
"liquid.css"

getCoreToLogicPath :: IO FilePath
getCoreToLogicPath :: IO String
getCoreToLogicPath = do
    let fileName :: String
fileName = String
"CoreToLogic.lg"

    -- Try to find it first at executable path
    String
exePath <- String -> String
dropFileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getExecutablePath
    let atExe :: String
atExe = String
exePath String -> String -> String
</> String
fileName
    Bool
exists <- String -> IO Bool
doesFileExist String
atExe

    if Bool
exists then
      forall (m :: * -> *) a. Monad m => a -> m a
return String
atExe
    else
      String -> IO String
getDataFileName (String
"include" String -> String -> String
</> String
fileName)

{-@ 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
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
ys = forall a. a -> Maybe a
Just (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [b]
ys)
  | Bool
otherwise              = 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) forall a. a -> [a] -> [a]
: forall t t1. String -> [t] -> [t1] -> [(t, t1)]
safeZipWithError String
msg [t]
xs [t1]
ys
safeZipWithError String
_   []     []     = []
safeZipWithError String
msg [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) forall a. a -> [a] -> [a]
: 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]
_      = 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) forall a. a -> [a] -> [a]
: 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]
_      = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[a1]
ys a
n -> 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 forall a. a -> [a] -> [a]
: [a1]
xs
mapN a
n a1 -> a1
f (a1
x:[a1]
xs) = a1
x forall a. a -> [a] -> [a]
: forall a a1. (Eq a, Num a) => a -> (a1 -> a1) -> [a1] -> [a1]
mapN (a
nforall 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
_ []     []     = forall (m :: * -> *) a. Monad m => a -> m a
return []
zipWithDefM a -> a -> m a
_ [a]
xs     []     = forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
zipWithDefM a -> a -> m a
_ []     [a]
ys     = 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) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> m a
f a
x a
y forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall a. a -> [a] -> [a]
: forall a. (a -> a -> a) -> [a] -> [a] -> [a]
zipWithDef a -> a -> a
f [a]
xs [a]
ys


--------------------------------------------------------------------------------
-- 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)

mapSnd3 :: (t -> t2) -> (t1, t, t3) -> (t1, t2, t3)
mapSnd3 :: forall t t2 t1 t3. (t -> t2) -> (t1, t, t3) -> (t1, t2, t3)
mapSnd3 t -> t2
f (t1
x, t
y, t3
z) = (t1
x, t -> t2
f t
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 = forall a. (?callStack::CallStack) => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
M.traverseWithKey (\k
k v1
v -> 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 = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first k1 -> k2
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, 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' = forall k v. HashMap k v -> [(k, v)]
M.toList (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' 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                = 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')
      | forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
M.member k
k HashMap k v
m  = 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 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall t.
[(ByteString, t)]
-> ByteString -> [(Int, t, (ByteString, ByteString))]
splitters [(ByteString, ByteString)]
seps ByteString
str of
      [] -> forall a. Maybe a
Nothing
      [(Int, ByteString, (ByteString, ByteString))]
is -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.minimumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` 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 (forall a b. (a, b) -> a
fst (ByteString, ByteString)
z)
                , Int
i 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               = 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 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 forall a. a -> [a] -> [a]
: ByteString
s2' 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 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             = forall a. Ord a => [a] -> [a] -> [a]
go (forall a. Ord a => [a] -> [a]
sortNub [a]
x1s) (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 forall a. Ord a => a -> a -> Bool
<  a
y               = a
x forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs' [a]
ys
      | a
x 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Ex.catch IO ()
a forall a b. (a -> b) -> a -> b
$ \IOException
e -> do
    let err :: String
err = forall a. Show a => a -> String
show (IOException
e :: Ex.IOException)
    String -> IO ()
writeLoud (String
"Warning: Couldn't do " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
err)
    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 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 = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> 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 = forall a. Show a => a -> String
show Int
n 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 =
  forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\b
x a
acc -> forall a b. (a, b) -> (b, a)
swap 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 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [v]
M.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k v. HashMap k v -> [v]
M.elems forall a b. (a -> b) -> a -> b
$ 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 =  forall k v. HashMap k v -> [v]
M.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. [a] -> [b] -> [(a, b)]
`zip` [a]
xs) 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 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 = forall k v e.
(Eq k, Hashable k) =>
((k, [v]) -> Either e v) -> [(k, v)] -> Either e [v]
uniqueByKey' forall {a} {b}. (a, [b]) -> Either (a, [b]) b
tx
  where
    tx :: (a, [b]) -> Either (a, [b]) b
tx (a
_, [b
v]) = forall a b. b -> Either a b
Right b
v
    tx (a
k, [b]
vs)  = 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (k, [v]) -> Either e v
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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       = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(b, c)]
bCs
    b2cs :: b -> [c]
b2cs b
b   = forall a. Maybe a -> [a]
maybeToList (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) = forall {b}. [(r, b)] -> (r, b)
getFst [(r, v)]
rvs ]
  where
    getFst :: [(r, b)] -> (r, b)
getFst     = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
    krvss :: [(k, [(r, v)])]
krvss      = 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 = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare 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 forall k v. (Eq k, Hashable k) => [(k, v)] -> [(k, [v])]
groupList [(k, a)]
kvs of
  []   -> []
  [(k, [a])]
kvss -> forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst 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 = forall a b. [Either a b] -> Either [a] [b]
catEithers (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
  [] -> forall a b. b -> Either a b
Right [b]
rs
  [a]
_  -> 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 = forall k v. HashMap k v -> [v]
M.elems (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          = 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 = (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([a], [b])]
xsyss, forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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)
  String
res <- String -> IO String
readFile String
f
  forall a. a -> IO a
Ex.evaluate String
res

lastModified :: FilePath -> IO (Maybe UTCTime)
lastModified :: String -> IO (Maybe UTCTime)
lastModified String
f = do
  Bool
ex  <- String -> IO Bool
doesFileExist String
f
  if Bool
ex then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
f
        else forall (m :: * -> *) a. Monad m => a -> m a
return   forall a. Maybe a
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) = forall e a. e -> Validate e a
Err e
e
  fmap a -> b
f (Val a
v)  = 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 = 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 = forall e a. e -> Validate e a
Err (e
e1 forall a. Semigroup a => a -> a -> a
<> e
e2)
  (Err e
e1) <*> Validate e a
_      = forall e a. e -> Validate e a
Err e
e1
  Validate e (a -> b)
_        <*> Err e
e2 = forall e a. e -> Validate e a
Err e
e2
  (Val a -> b
f)  <*> Val a
x  = forall e a. a -> Validate e a
Val (a -> b
f a
x)