{-# LANGUAGE GADTs, RecordWildCards, FlexibleInstances
  #-}
import Control.Applicative
import Data.Function
import Data.List

goatse = do
  g <- choice' ["g", "9", "6", "Г", "Γ", "r"]
  o <- choice' ["0", "о", "ο", "()"]
  a <- choice' ["a", "4", "α", "@"]
  t <- choice' ["t", "7", "+", "т", "m", "τ"]
  s <- choice' ["s", "5", "с", "σ", "c", "$"]
  e <- choice' ["e", "3", "е", "ε"]
  let str = concat [g, o, a, t, s, e]
  {- ideone не ест юникодики, не беда -- введём костыль (ниже) -}
  guard $ all ((<255).fromEnum) str
  return str

choice' = choice . (zip [1..]) 

class Monad m => MonadVoretion m where
  -- | Bernoulli distribution. Returns either of the arguments with
  -- certain probability
  fork :: Float  -- ^ Probability of the first value
       -> a      -- ^ First value
       -> a      -- ^ Second value
       -> m a

  -- | Aborts execution if some condition isn't met
  guard :: Bool  -- ^ Condition
        -> m ()

data Sample m a where
  Fork :: {
    _metaInfo :: !m
  , _left
  , _right :: r
  , _bias :: !Float
  , _next :: r -> Sample m a
  } -> Sample m a
  -- | Val is just a pure value
  Val :: {
    _unVal :: a
  } -> Sample m a
  -- | Guard checks some expression and backtracks if it isn't true
  Guard :: {
    _metaInfo :: !m
  , _guarded :: Sample m a
  } -> Sample m a
  Zero :: Sample m a

instance Functor (Sample m) where
  fmap f a@Val{_unVal=v} = a{_unVal=f v}
  fmap f a@Fork{..} = Fork {
      _next = \a -> fmap f $ _next a
    , ..
    }
  fmap _ Zero = Zero
  fmap f a@Guard{..} = Guard {
      _guarded = fmap f _guarded
    , ..
    }

instance Applicative (Sample m) where
  pure a = Val a

  Val{_unVal=f} <*> a = fmap f a
  Fork{..} <*> a = Fork {
      _next = \x -> (_next x) <*> a
    , ..
    }
  Zero <*> _ = Zero
  Guard{..} <*> a = Guard {
      _guarded = _guarded <*> a
    , ..
    }

instance Monad (Sample m) where
  Val{_unVal=v} >>= f = f v
  Fork{..}      >>= f = Fork {
       _next = \a -> _next a >>= f
     , ..
     }
  Zero          >>= _ = Zero
  Guard{..}     >>= f = Guard {
      _guarded = _guarded >>= f
    , ..
    }

  return = pure
  
class Default a where
  deFault :: a

instance Default () where
  deFault = ()

instance (Default m) => MonadVoretion (Sample m) where
  fork b x y = Fork {
      _metaInfo = deFault
    , _left = x
    , _right = y
    , _bias = b
    , _next = \a -> Val{_unVal=a}
    }

  guard False = Zero
  guard True = Guard {
      _guarded = Val ()
    , _metaInfo = deFault
    }

choice :: MonadVoretion m => [(Float, a)] -> m a
choice l = go (reverse $ scanl (\a b -> fst b + a) 0 l) $ reverse l 
  where
    go _ [(_,x)] = return x
    go (pc:tp) ((p,x):t) = do
      c <- fork (p/pc) True False
      if c then
        return x
      else
        go tp t

cobenation :: Float -> Sample () b -> [(Float, b)]
cobenation ε = go 1
  where
    go _ Zero = []
    go n _ | n<ε = []
    go n Val{_unVal=v} = [(n, v)]
    go n Guard{_guarded=g} = go n g
    go n Fork{_bias=b, _next=f, _left=l, _right=r} = go (n*b) (f l) ++ go (n*(1-b)) (f r)
    
main = mapM putStrLn $ map snd $ cobenation 0 goatse