-- | Miscellaneous utility functions
module Data.Generics.Fixplate.Misc where

--------------------------------------------------------------------------------

import Prelude hiding (mapM,mapM_)
import Control.Monad (liftM)
import Data.Traversable
--import Control.Monad.Trans.State

--------------------------------------------------------------------------------
        
data Two a b 
  =  Empty 
  |  One a
  |  Two b
  deriving Show
  
data Both a b 
  =  None
  |  First a
  |  Both  a b
  deriving Show

--------------------------------------------------------------------------------

unsafe :: (a -> Maybe b) -> String -> a -> b
unsafe safe msg loc = case safe loc of
  Just new -> new
  Nothing  -> error msg
  
--------------------------------------------------------------------------------

app_prec :: Int
app_prec = 10

--------------------------------------------------------------------------------

(<#>) :: (a -> b) -> (c -> d) -> (a,c) -> (b,d)
(f <#> g) (x,y) = (f x, g y)

--------------------------------------------------------------------------------

tillNothing :: (a -> Maybe a) -> a -> a
tillNothing f = go where 
  go x = case f x of { Nothing -> x ; Just y -> go y }
  
chain :: [a -> Maybe a] -> a -> Maybe a
chain [] x = return x
chain (f:fs) x = (f x) >>= chain fs 
  
chainJust :: [a -> Maybe a] -> a -> a
chainJust fs x = case chain fs x of
  Nothing -> error "chainJust: Nothing"
  Just y  -> y
  
--------------------------------------------------------------------------------  

iterateN :: Int -> (a -> a) -> a -> a
iterateN n f = go n where 
  go 0 x = x
  go n x = go (n-1) (f x)

--------------------------------------------------------------------------------  

mapM_ :: (Traversable t, Monad m) => (a -> m ()) -> t a -> m ()
mapM_ act t = do
  _ <- mapM act t
  return ()

mapAccumM :: (Traversable t, Monad m) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM act x0 t = runStateT (mapM (StateT . flip act) t) x0 where

--------------------------------------------------------------------------------  

newtype StateT s m a = StateT { runStateT :: s -> m (s,a) }

instance (Monad m) => Monad (StateT s m) where
  return a = state $ \s -> (s,a)
  m >>= k  = StateT $ \s -> do
    ~(s', a) <- runStateT m s
    runStateT (k a) s'
  fail str = StateT $ \_ -> fail str

state :: Monad m => (s -> (s,a)) -> StateT s m a 
state f = StateT (return . f)

sget :: (Monad m) => StateT s m s
sget = state $ \s -> (s,s)

sput :: (Monad m) => s -> StateT s m ()
sput s = state $ \_ -> (s,())

smodify :: (Monad m) => (s -> s) -> StateT s m ()
smodify f = state $ \s -> (f s,())

--------------------------------------------------------------------------------