{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections, NoMonomorphismRestriction,
      FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}

module Util (module Util, module X) where

-- reexports:
import Data.List as X (intercalate)

import Prelude hiding (showList, null, (<>))

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, (<$>))
#endif
import Control.Monad
import Control.Monad.Writer (Writer, runWriter)

import qualified Data.List.NonEmpty as List1
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid (All, getAll)
import Debug.Trace

import Text.PrettyPrint as PP

type List1 = List1.NonEmpty

(+?+) :: String -> String -> String
+?+ :: String -> String -> String
(+?+) String
_ String
"[]" = []
(+?+) String
xs String
ys  = String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ys

implies :: Bool -> Bool -> Bool
implies :: Bool -> Bool -> Bool
implies Bool
a Bool
b = if Bool
a then Bool
b else Bool
True

class Pretty a where
    pretty      :: a -> Doc
    prettyPrec  :: Int -> a -> Doc

    pretty      = Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
0
    prettyPrec  = (a -> Doc) -> Int -> a -> Doc
forall a b. a -> b -> a
const a -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Pretty Doc where
    pretty :: Doc -> Doc
pretty = Doc -> Doc
forall a. a -> a
id

angleBrackets :: Doc -> Doc
angleBrackets :: Doc -> Doc
angleBrackets Doc
d = String -> Doc
text String
"<" Doc -> Doc -> Doc
<+> Doc
d Doc -> Doc -> Doc
<+> String -> Doc
text String
">"

-- | Apply when condition is @True@.
fwhen :: Bool -> (a -> a) -> a -> a
fwhen :: forall a. Bool -> (a -> a) -> a -> a
fwhen Bool
True  a -> a
f a
a = a -> a
f a
a
fwhen Bool
False a -> a
_ a
a = a
a

parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf Bool
b = Bool -> (Doc -> Doc) -> Doc -> Doc
forall a. Bool -> (a -> a) -> a -> a
fwhen Bool
b Doc -> Doc
PP.parens

hsepBy :: Doc -> [Doc] -> Doc
hsepBy :: Doc -> [Doc] -> Doc
hsepBy Doc
_separator []     = Doc
empty
hsepBy Doc
_separator [Doc
d]    = Doc
d
hsepBy  Doc
separator (Doc
d:[Doc]
ds) = Doc
d Doc -> Doc -> Doc
<> Doc
separator Doc -> Doc -> Doc
<> Doc -> [Doc] -> Doc
hsepBy Doc
separator [Doc]
ds

pwords :: String -> [Doc]
pwords :: String -> [Doc]
pwords = (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

fwords :: String -> Doc
fwords :: String -> Doc
fwords = [Doc] -> Doc
fsep ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Doc]
pwords

fromAllWriter :: Writer All a -> (Bool, a)
fromAllWriter :: forall a. Writer All a -> (Bool, a)
fromAllWriter Writer All a
m = let (a
a, All
w) = Writer All a -> (a, All)
forall w a. Writer w a -> (a, w)
runWriter Writer All a
m
                  in  (All -> Bool
getAll All
w, a
a)

traceM :: (Monad m) => String -> m ()
traceM :: forall (m :: * -> *). Monad m => String -> m ()
traceM String
msg = String -> m () -> m ()
forall a. String -> a -> a
trace String
msg (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

infixr 9 <.>

-- | Composition: pure function after monadic function.
(<.>) :: Functor m => (b -> c) -> (a -> m b) -> a -> m c
(b -> c
f <.> :: forall (m :: * -> *) b c a.
Functor m =>
(b -> c) -> (a -> m b) -> a -> m c
<.> a -> m b
g) a
a = b -> c
f (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
g a
a

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
mb m ()
k = m Bool
mb m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
k)

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
mb m ()
k = m Bool
mb m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` m ()
k)

whenJustM :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
whenJustM :: forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM m (Maybe a)
mm a -> m ()
k = m (Maybe a)
mm m (Maybe a) -> (Maybe a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
`whenJust` a -> m ()
k)

whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (Just a
a) a -> m ()
k = a -> m ()
k a
a
whenJust Maybe a
Nothing  a -> m ()
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

whenNothing :: (Monad m) => Maybe a -> m () -> m ()
whenNothing :: forall (m :: * -> *) a. Monad m => Maybe a -> m () -> m ()
whenNothing Maybe a
Nothing m ()
m = m ()
m
whenNothing Just{}  m ()
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

ifNothingM :: (Monad m) => m (Maybe a) -> m b -> (a -> m b) -> m b
ifNothingM :: forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
ifNothingM m (Maybe a)
mma m b
mb a -> m b
f = m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
mb a -> m b
f (Maybe a -> m b) -> m (Maybe a) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe a)
mma

ifJustM :: (Monad m) => m (Maybe a) -> (a -> m b) -> m b -> m b
ifJustM :: forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m b) -> m b -> m b
ifJustM m (Maybe a)
mma a -> m b
f m b
mb = m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
mb a -> m b
f (Maybe a -> m b) -> m (Maybe a) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe a)
mma

mapMapM :: (Monad m, Ord k) => (a -> m b) -> Map k a -> m (Map k b)
mapMapM :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> m b) -> Map k a -> m (Map k b)
mapMapM a -> m b
f = (k -> a -> m (Map k b) -> m (Map k b))
-> m (Map k b) -> Map k a -> m (Map k b)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> a -> m (Map k b) -> m (Map k b)
forall {k}. Ord k => k -> a -> m (Map k b) -> m (Map k b)
step (Map k b -> m (Map k b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k b -> m (Map k b)) -> Map k b -> m (Map k b)
forall a b. (a -> b) -> a -> b
$ Map k b
forall k a. Map k a
Map.empty)
  where step :: k -> a -> m (Map k b) -> m (Map k b)
step k
k a
a m (Map k b)
m = do a' <- a -> m b
f a
a
                        m' <- m
                        return $ Map.insert k a' m'

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
c m a
d m a
e = do { b <- m Bool
c ; if b then d else e }

{- Control.Monad.IfElse
whenM :: Monad m => m Bool -> m () -> m ()
whenM c d = do { b <- c; if b then d else return () }

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM c e = do { b <- c; if b then return () else e }
-}

andLazy :: Monad m => m Bool -> m Bool -> m Bool
andLazy :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
andLazy m Bool
ma m Bool
mb = m Bool -> m Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
ma m Bool
mb (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

andM  :: Monad m => [m Bool] -> m Bool
andM :: forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM []     = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
andM (m Bool
m:[m Bool]
ms) = m Bool
m m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
`andLazy` [m Bool] -> m Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM [m Bool]
ms

findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
_ []       = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
findM a -> m Bool
p (a
x : [a]
xs) = do b <- a -> m Bool
p a
x
                      if b then return (Just x) else findM p xs

-- | Binary version of @=<<@.
(==<<) :: Monad m => (a -> b -> m c) -> (m a, m b) -> m c
a -> b -> m c
f ==<< :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> (m a, m b) -> m c
==<< (m a
ma, m b
mb) = do { a <- m a
ma; f a =<< mb }

parens :: String -> String
parens :: String -> String
parens String
s = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

brackets :: String -> String
brackets :: String -> String
brackets String
s = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

bracketsIf :: Bool -> String -> String
bracketsIf :: Bool -> String -> String
bracketsIf Bool
False String
s = String
s
bracketsIf Bool
True  String
s = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

separate :: String -> String -> String -> String
separate :: String -> String -> String -> String
separate String
_separator String
"" String
y = String
y
separate String
_separator String
x String
"" = String
x
separate  String
separator String
x String
y  = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
separator String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y

showList :: String -> (a -> String) -> [a] -> String
showList :: forall a. String -> (a -> String) -> [a] -> String
showList String
_separator a -> String
_ [] = String
""
showList String
_separator a -> String
f [a
e] = a -> String
f a
e
showList  String
separator a -> String
f (a
e:[a]
es) = a -> String
f a
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
separator String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (a -> String) -> [a] -> String
forall a. String -> (a -> String) -> [a] -> String
showList String
separator a -> String
f [a]
es
-- OR: showList separator f es = foldl separate "" $ map f es

hasDuplicate :: (Eq a) => [a] -> Bool
hasDuplicate :: forall a. Eq a => [a] -> Bool
hasDuplicate [] = Bool
False
hasDuplicate (a
x : [a]
xs) = a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs Bool -> Bool -> Bool
|| [a] -> Bool
forall a. Eq a => [a] -> Bool
hasDuplicate [a]
xs

compressMaybes :: [Maybe a] -> [a]
compressMaybes :: forall a. [Maybe a] -> [a]
compressMaybes = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([Maybe a] -> [[a]]) -> [Maybe a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> [a]) -> [Maybe a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ a
a -> [a
a]))

mapFst :: (a -> c) -> (a,d) -> (c,d)
mapFst :: forall a c d. (a -> c) -> (a, d) -> (c, d)
mapFst a -> c
f (a
a,d
b) = (a -> c
f a
a, d
b)

mapSnd :: (b -> d) -> (a,b) -> (a,d)
mapSnd :: forall b d a. (b -> d) -> (a, b) -> (a, d)
mapSnd b -> d
f (a
a,b
b) = (a
a, b -> d
f b
b)

mapPair :: (a -> c) -> (b -> d) -> (a,b) -> (c,d)
mapPair :: forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
mapPair a -> c
f b -> d
g (a
a,b
b) = (a -> c
f a
a, b -> d
g b
b)

zipPair :: (a -> b -> c) -> (d -> e -> f) -> (a,d) -> (b,e) -> (c,f)
zipPair :: forall a b c d e f.
(a -> b -> c) -> (d -> e -> f) -> (a, d) -> (b, e) -> (c, f)
zipPair a -> b -> c
f d -> e -> f
g (a
a,d
d) (b
b,e
e) = (a -> b -> c
f a
a b
b, d -> e -> f
g d
d e
e)

headMaybe :: [a] -> Maybe a
headMaybe :: forall a. [a] -> Maybe a
headMaybe [] = Maybe a
forall a. Maybe a
Nothing
headMaybe (a
a:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

firstJust :: [Maybe a] -> Maybe a
firstJust :: forall a. [Maybe a] -> Maybe a
firstJust = [a] -> Maybe a
forall a. [a] -> Maybe a
headMaybe ([a] -> Maybe a) -> ([Maybe a] -> [a]) -> [Maybe a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
compressMaybes

firstJustM :: Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM :: forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM [] = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
firstJustM (m (Maybe a)
mm : [m (Maybe a)]
mms) = do
  m <- m (Maybe a)
mm
  case m of
    Maybe a
Nothing -> [m (Maybe a)] -> m (Maybe a)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM [m (Maybe a)]
mms
    Just{}  -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
m

for, mapOver :: (Functor f) => f a -> (a -> b) -> f b
mapOver :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
mapOver = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

for :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for = f a -> (a -> b) -> f b
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
mapOver

mapAssoc :: (a -> b) -> [(n,a)] -> [(n,b)]
mapAssoc :: forall a b n. (a -> b) -> [(n, a)] -> [(n, b)]
mapAssoc a -> b
f = ((n, a) -> (n, b)) -> [(n, a)] -> [(n, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (n
n, a
a) -> (n
n, a -> b
f a
a))

mapAssocM :: (Applicative m, Monad m) => (a -> m b) -> [(n,a)] -> m [(n,b)]
mapAssocM :: forall (m :: * -> *) a b n.
(Applicative m, Monad m) =>
(a -> m b) -> [(n, a)] -> m [(n, b)]
mapAssocM a -> m b
f = ((n, a) -> m (n, b)) -> [(n, a)] -> m [(n, 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) -> [a] -> m [b]
mapM (\ (n
n, a
a) -> (n
n,) (b -> (n, b)) -> m b -> m (n, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a)

compAssoc :: Eq b => [(a,b)] -> [(b,c)] -> [(a,c)]
compAssoc :: forall b a c. Eq b => [(a, b)] -> [(b, c)] -> [(a, c)]
compAssoc [(a, b)]
xs [(b, c)]
ys = [ (a
a,c
c) | (a
a,b
b) <- [(a, b)]
xs, (b
b',c
c) <- [(b, c)]
ys, b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b' ]

-- * Lists and stacks of lists

class Push a b where
  push    :: a -> b -> b

instance Push a [a] where
  push :: a -> [a] -> [a]
push = (:)

instance Push a [[a]] where
  push :: a -> [[a]] -> [[a]]
push a
a ([a]
b:[[a]]
bs) = (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
b) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
bs
  push a
_ []     = [[a]]
forall a. HasCallStack => a
undefined

-- TOO HARD for ghc:
-- instance Push a b => Push a [b] where
--   push a (b:bs) = push a b : bs

class Retrieve a b c | b -> c where
  retrieve :: Eq a => a -> b -> Maybe c

instance Retrieve a [(a,b)] b where
  retrieve :: Eq a => a -> [(a, b)] -> Maybe b
retrieve = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup

instance Retrieve a [[(a,b)]] b where
  retrieve :: Eq a => a -> [[(a, b)]] -> Maybe b
retrieve a
a = a -> [(a, b)] -> Maybe b
forall a b c. (Retrieve a b c, Eq a) => a -> b -> Maybe c
retrieve a
a ([(a, b)] -> Maybe b)
-> ([[(a, b)]] -> [(a, b)]) -> [[(a, b)]] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, b)]] -> [(a, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

-- instance Retrieve a b c => Retrieve a [b] c where
--   retrieve a = firstJust . map (retrieve a)

{-
class ListLike a where
  length :: a -> Int
  null   :: a -> Bool
  nil    :: a
-}

class Size a where
  size :: a -> Int

instance Size [a] where
  size :: [a] -> Int
size = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

class Null a where
  null :: a -> Bool

instance Null [a] where
  null :: [a] -> Bool
null = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null