content: {-# 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
  (.&&.) = up (&&)
  (.||.) = up (||)
  
  up :: (b -> c -> d) -> (a -> b) -> (a -> c) -> (a -> d)
  up o f g x = f x `o` g x
  
  timedAction :: (Show msg) => Maybe msg -> IO a -> IO a
  timedAction label io = do
    t0 <- getCurrentTime
    a <- io
    t1 <- getCurrentTime
    let time = realToFrac (t1 `diffUTCTime` t0) :: Double
    case label of
      Just x  -> printf "Time (%.2fs) for action %s \n" time (show x)
      Nothing -> return ()
    return a
  
  (!?) :: [a] -> Int -> Maybe a
  []     !? _ = Nothing
  (x:_)  !? 0 = Just x
  (_:xs) !? n = xs !? (n-1)
  
  safeFromJust :: String -> Maybe t -> t
  safeFromJust _  (Just x) = x
  safeFromJust err _       = errorstar err
  
  safeFromLeft :: String -> Either a b -> a
  safeFromLeft _   (Left l) = l
  safeFromLeft err _        = errorstar err
  
  
  takeLast :: Int -> [a] -> [a]
  takeLast n xs = drop (m - n) xs
    where
      m         = length xs
  
  getNth :: Int -> [a] -> Maybe a
  getNth 0 (x:_)  = Just x
  getNth n (_:xs) = getNth (n-1) xs
  getNth _ _      = Nothing
  
  fst4 :: (t, t1, t2, t3) -> t
  fst4 (a,_,_,_) = a
  
  snd4 :: (t, t1, t2, t3) -> t1
  snd4 (_,b,_,_) = b
  
  thd4 :: (t1, t2, t3, t4) -> t3
  thd4 (_,_,b,_) = b
  
  
  thrd3 :: (t1, t2, t3) -> t3
  thrd3 (_,_,c) = c
  
  mapFifth5 :: (t -> t4) -> (t0, t1, t2, t3, t) -> (t0, t1, t2, t3, t4)
  mapFifth5 f (a, x, y, z, w) = (a, x, y, z, f w)
  
  mapFourth4 :: (t -> t4) -> (t1, t2, t3, t) -> (t1, t2, t3, t4)
  mapFourth4 f (x, y, z, w) = (x, y, z, f w)
  
  addFst3 :: t -> (t1, t2) -> (t, t1, t2)
  addFst3   a (b, c) = (a, b, c)
  
  addThd3 :: t2 -> (t, t1) -> (t, t1, t2)
  addThd3   c (a, b) = (a, b, c)
  
  dropFst3 :: (t, t1, t2) -> (t1, t2)
  dropFst3 (_, x, y) = (x, y)
  
  dropThd3 :: (t1, t2, t) -> (t1, t2)
  dropThd3 (x, y, _) = (x, y)
  
  replaceN :: (Enum a, Eq a, Num a) => a -> t -> [t] -> [t]
  replaceN n y ls = [if i == n then y else x | (x, i) <- zip ls [0..]]
  
  
  thd5 :: (t0, t1, t2, t3, t4) -> t2
  thd5 (_,_,x,_,_) = x
  
  snd5 :: (t0, t1, t2, t3, t4) -> t1
  snd5 (_,x,_,_,_) = x
  
  fst5 :: (t0, t1, t2, t3, t4) -> t0
  fst5 (x,_,_,_,_) = x
  
  fourth4 :: (t, t1, t2, t3) -> t3
  fourth4 (_,_,_,x) = x
  
  third4 :: (t, t1, t2, t3) -> t2
  third4  (_,_,x,_) = x
  
  firstM :: Functor f => (t -> f a) -> (t, t1) -> f (a, t1)
  firstM  f (a,b) = (,b) <$> f a
  
  secondM :: Functor f => (t -> f a) -> (t1, t) -> f (t1, a)
  secondM f (a,b) = (a,) <$> f b
  
  first3M :: Functor f => (t -> f a) -> (t, t1, t2) -> f (a, t1, t2)
  first3M  f (a,b,c) = (,b,c) <$> f a
  
  second3M :: Functor f => (t -> f a) -> (t1, t, t2) -> f (t1, a, t2)
  second3M f (a,b,c) = (a,,c) <$> f b
  
  third3M :: Functor f => (t -> f a) -> (t1, t2, t) -> f (t1, t2, a)
  third3M  f (a,b,c) = (a,b,) <$> f c
  
  third3 :: (t -> t3) -> (t1, t2, t) -> (t1, t2, t3)
  third3 f (a,b,c) = (a,b,f c)
  
  zip4 :: [t] -> [t1] -> [t2] -> [t3] -> [(t, t1, t2, t3)]
  zip4 (x1:xs1) (x2:xs2) (x3:xs3) (x4:xs4) = (x1, x2, x3, x4) : zip4 xs1 xs2 xs3 xs4
  zip4 _ _ _ _                             = []
  
  zip5 :: [t] -> [t1] -> [t2] -> [t3] -> [t4] -> [(t, t1, t2, t3, t4)]
  zip5 (x1:xs1) (x2:xs2) (x3:xs3) (x4:xs4) (x5:xs5) = (x1, x2, x3, x4,x5) : zip5 xs1 xs2 xs3 xs4 xs5
  zip5 _ _ _ _ _                                    = []
  
  
  
  unzip4 :: [(t, t1, t2, t3)] -> ([t],[t1],[t2],[t3])
  unzip4 = go [] [] [] []
    where go a1 a2 a3 a4 ((x1,x2,x3,x4):xs) = go (x1:a1) (x2:a2) (x3:a3) (x4:a4) xs
          go a1 a2 a3 a4 [] = (reverse  a1, reverse a2, reverse a3, reverse 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 xs ys
    | length xs == length ys = Just (zip xs ys)
    | otherwise              = Nothing
  
  {-@ safeZipWithError :: _ -> xs:[a] -> ListL b xs -> ListL (a,b) xs / [xs] @-}
  safeZipWithError :: String -> [t] -> [t1] -> [(t, t1)]
  safeZipWithError msg (x:xs) (y:ys) = (x,y) : safeZipWithError msg xs ys
  safeZipWithError _   []     []     = []
  safeZipWithError msg _      _      = errorstar msg
  
  safeZip3WithError :: String -> [t] -> [t1] -> [t2] -> [(t, t1, t2)]
  safeZip3WithError msg (x:xs) (y:ys) (z:zs) = (x,y,z) : safeZip3WithError msg xs ys zs
  safeZip3WithError _   []     []     []     = []
  safeZip3WithError msg _      _      _      = errorstar msg
  
  safeZip4WithError :: String -> [t1] -> [t2] -> [t3] -> [t4] -> [(t1, t2, t3, t4)]
  safeZip4WithError msg (x:xs) (y:ys) (z:zs) (w:ws) = (x,y,z,w) : safeZip4WithError msg xs ys zs ws
  safeZip4WithError _   []     []     []     []     = []
  safeZip4WithError msg _      _      _      _      = errorstar msg
  
  
  mapNs :: (Eq a, Num a, Foldable t) => t a -> (a1 -> a1) -> [a1] -> [a1]
  mapNs ns f xs = foldl (\ys n -> mapN n f ys) xs ns
  
  mapN :: (Eq a, Num a) => a -> (a1 -> a1) -> [a1] -> [a1]
  mapN 0 f (x:xs) = f x : xs
  mapN n f (x:xs) = x : mapN (n-1) f xs
  mapN _ _ []     = []
  
  zipWithDefM :: Monad m => (a -> a -> m a) -> [a] -> [a] -> m [a]
  zipWithDefM _ []     []     = return []
  zipWithDefM _ xs     []     = return xs
  zipWithDefM _ []     ys     = return ys
  zipWithDefM f (x:xs) (y:ys) = (:) <$> f x y <*> zipWithDefM f xs ys
  
  zipWithDef :: (a -> a -> a) -> [a] -> [a] -> [a]
  zipWithDef _ []     []     = []
  zipWithDef _ xs     []     = xs
  zipWithDef _ []     ys     = ys
  zipWithDef f (x:xs) (y:ys) = f x y : zipWithDef f xs ys
  
  
  foldMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b
  foldMapM f xs = foldr step return xs mempty
    where
      step x r z = f x >>= \y -> r $! z `mappend` y
  
  --------------------------------------------------------------------------------
  -- Originally part of Fixpoint's Misc:
  --------------------------------------------------------------------------------
  
  single :: t -> [t]
  single x = [x]
  
  mapFst3 :: (t -> t1) -> (t, t2, t3) -> (t1, t2, t3)
  mapFst3 f (x, y, z) = (f x, y, z)
  
  mapThd3 :: (t -> t3) -> (t1, t2, t) -> (t1, t2, t3)
  mapThd3 f (x, y, z) = (x, y, f z)
  
  hashMapMapWithKey   :: (k -> v1 -> v2) -> M.HashMap k v1 -> M.HashMap k v2
  hashMapMapWithKey f = fromJust . M.traverseWithKey (\k v -> Just (f k v))
  
  hashMapMapKeys   :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.HashMap k1 v -> M.HashMap k2 v
  hashMapMapKeys f = M.fromList . fmap (first f) . M.toList
  
  concatMapM :: (Monad m, Traversable t) => (a -> m [b]) -> t a -> m [b]
  concatMapM f = fmap concat . mapM f
  
  replaceSubset :: (Eq k, Hashable k) => [(k, a)] -> [(k, a)] -> [(k, a)]
  replaceSubset kvs kvs' = M.toList (L.foldl' upd m0 kvs')
    where
      m0                = M.fromList kvs
      upd m (k, v')
        | M.member k m  = M.insert k v' m
        | otherwise     = m
  
  replaceWith :: (Eq a, Hashable a) => (b -> a) -> [b] -> [b] -> [b]
  replaceWith f xs ys = snd <$> replaceSubset xs' ys'
    where
      xs'             = [ (f x, x) | x <- xs ]
      ys'             = [ (f y, y) | y <- ys ]
  
  
  
  
  firstElems ::  [(B.ByteString, B.ByteString)] -> B.ByteString -> Maybe (Int, B.ByteString, (B.ByteString, B.ByteString))
  firstElems seps str
    = case splitters seps str of
        [] -> Nothing
        is -> Just $ L.minimumBy (compare `on` fst3) is
  
  splitters :: [(B.ByteString, t)]
            -> B.ByteString -> [(Int, t, (B.ByteString, B.ByteString))]
  splitters seps str
    = [(i, c', z) | (c, c') <- seps
                  , let z   = B.breakSubstring c str
                  , let i   = B.length (fst z)
                  , i < B.length str                 ]
  
  bchopAlts :: [(B.ByteString, B.ByteString)] -> B.ByteString -> [B.ByteString]
  bchopAlts seps  = go
    where
      go  s               = maybe [s] go' (firstElems seps s)
      go' (_,c',(s0, s1)) = if B.length s2 == B.length s1 then [B.concat [s0,s1]] else s0 : s2' : go s3'
                            where (s2, s3) = B.breakSubstring c' s1
                                  s2'      = B.append s2 c'
                                  s3'      = B.drop (B.length c') s3
  
  chopAlts :: [(String, String)] -> String -> [String]
  chopAlts seps str = unpack <$> bchopAlts [(pack c, pack c') | (c, c') <- seps] (pack str)
  
  sortDiff :: (Ord a) => [a] -> [a] -> [a]
  sortDiff x1s x2s             = go (sortNub x1s) (sortNub x2s)
    where
      go xs@(x:xs') ys@(y:ys')
        | x <  y               = x : go xs' ys
        | x == y               = go xs' ys'
        | otherwise            = go xs ys'
      go xs []                 = xs
      go [] _                  = []
  
  (<->) :: PJ.Doc -> PJ.Doc -> PJ.Doc
  x <-> y = x PJ.<> y
  
  angleBrackets :: PJ.Doc -> PJ.Doc
  angleBrackets p = PJ.char '<' <-> p <-> PJ.char '>'
  
  mkGraph :: (Eq a, Eq b, Hashable a, Hashable b) => [(a, b)] -> M.HashMap a (S.HashSet b)
  mkGraph = fmap S.fromList . group
  
  tryIgnore :: String -> IO () -> IO ()
  tryIgnore s a =
    Ex.catch a $ \e -> do
      let err = show (e :: Ex.IOException)
      writeLoud ("Warning: Couldn't do " ++ s ++ ": " ++ err)
      return ()
  
  
  condNull :: Monoid m => Bool -> m -> m
  condNull c xs = if c then xs else mempty
  
  firstJust :: (a -> Maybe b) -> [a] -> Maybe b
  firstJust f xs = listToMaybe $ mapMaybe f xs
  
  intToString :: Int -> String
  intToString 1 = "1st"
  intToString 2 = "2nd"
  intToString 3 = "3rd"
  intToString n = show n ++ "th"
  
  mapAccumM :: (Monad m, Traversable t) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
  mapAccumM f acc0 xs =
    swap <$> runStateT (traverse (StateT . (\x acc -> swap <$> f acc x)) xs) acc0
  
  ifM :: (Monad m) => m Bool -> m b -> m b -> m b
  ifM b x y = b >>= \z -> if z then x else y
  
  nubHashOn :: (Eq k, Hashable k) => (a -> k) -> [a] -> [a]
  nubHashOn f = map head . M.elems . groupMap f
  
  nubHashLast :: (Eq k, Hashable k) => (a -> k) -> [a] -> [a]
  nubHashLast f xs = M.elems $ M.fromList [ (f x, x) | x <- xs ]
  
  nubHashLastM :: (Eq k, Hashable k, Monad m) => (a -> m k) -> [a] -> m [a]
  nubHashLastM f xs =  M.elems . M.fromList . (`zip` xs) <$> mapM f xs
  
  uniqueByKey :: (Eq k, Hashable k) => [(k, v)] -> Either (k, [v]) [v]
  uniqueByKey = uniqueByKey' tx
    where
      tx (_, [v]) = Right v
      tx (k, vs)  = Left  (k, vs)
  
  uniqueByKey' :: (Eq k, Hashable k) => ((k, [v]) -> Either e v) -> [(k, v)] -> Either e [v]
  uniqueByKey' tx = mapM tx . groupList
  
  
  join :: (Eq b, Hashable b) => [(a, b)] -> [(b, c)] -> [(a, c)]
  join aBs bCs = [ (a, c) | (a, b) <- aBs, c <- b2cs b ]
    where
      bM       = M.fromList bCs
      b2cs b   = maybeToList (M.lookup b bM)
  
  
  fstByRank :: (Ord r, Hashable k, Eq k) => [(r, k, v)] -> [(r, k, v)]
  fstByRank rkvs = [ (r, k, v) | (k, rvs) <- krvss, let (r, v) = getFst rvs ]
    where
      getFst     = head . sortOn fst
      krvss      = groupList [ (k, (r, v)) | (r, k, v) <- rkvs ]
  
  ordNub :: Ord a => [a] -> [a]
  ordNub = map head . L.group . L.sort
  
  sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
  sortOn f = L.sortBy (compare `on` f)
  
  firstGroup :: (Eq k, Ord k, Hashable k) => [(k, a)] -> [a]
  firstGroup kvs = case groupList kvs of
    []   -> []
    kvss -> snd . head . sortOn fst $ 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 f xs = catEithers (map f xs)
  
  catEithers :: [ Either a b ] -> Either [a] [b]
  catEithers zs = case ls of
    [] -> Right rs
    _  -> Left ls
    where
      ls = [ l | Left  l <- zs ]
      rs = [ r | Right r <- zs ]
  
  
  keyDiff :: (Eq k, Hashable k) => (a -> k) -> [a] -> [a] -> [a]
  keyDiff f x1s x2s = M.elems (M.difference (m x1s) (m x2s))
    where
      m xs          = M.fromList [(f x, x) | x <- xs]
  
  concatUnzip :: [([a], [b])] -> ([a], [b])
  concatUnzip xsyss = (concatMap fst xsyss, concatMap snd xsyss)
  
  
  sayReadFile :: FilePath -> IO String
  sayReadFile f = do
    -- print ("SAY-READ-FILE: " ++ f)
    res <- readFile f
    Ex.evaluate res
  
  lastModified :: FilePath -> IO (Maybe UTCTime)
  lastModified f = do
    ex  <- doesFileExist f
    if ex then Just <$> getModificationTime f
          else return   Nothing
  
  
  data Validate e a = Err e | Val a
  
  instance Functor (Validate e) where
    fmap _ (Err e) = Err e
    fmap f (Val v)  = Val (f v)
  
  instance Monoid e => Applicative (Validate e) where
    pure = Val
    (Err e1) <*> Err e2 = Err (e1 <> e2)
    (Err e1) <*> _      = Err e1
    _        <*> Err e2 = Err e2
    (Val f)  <*> Val x  = Val (f x)
  