{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TupleSections          #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}
module Imm.Prelude (module Imm.Prelude, module X) where

-- {{{ Imports
import           Control.Applicative             as X
import           Control.Comonad
import           Control.Comonad.Cofree
import           Control.Monad                   as X (MonadPlus (..), unless,
                                                       void, when)
import           Control.Monad.Catch             as X
import           Control.Monad.IO.Class          as X
import           Control.Monad.Trans.Free        (FreeF (..), FreeT (..))

import           Data.Bifunctor                  as X
import qualified Data.ByteString                 as B (ByteString ())
import qualified Data.ByteString.Lazy            as LB (ByteString ())
import           Data.Comp.Ops                   as X
import           Data.Containers                 as X
import           Data.Foldable                   as X (forM_)
import           Data.Functor.Identity
import           Data.IOData                     as X
import           Data.Map                        as X (Map)
import           Data.Maybe                      as X hiding (catMaybes)
import           Data.Monoid                     as X
import           Data.Monoid.Textual             as X (TextualMonoid (),
                                                       fromText)
import           Data.MonoTraversable.Unprefixed as X hiding (forM_, mapM_)
import           Data.Ord                        as X
import           Data.Sequences                  as X
import           Data.String                     as X (IsString (..))
import qualified Data.Text                       as T (Text ())
import qualified Data.Text.Lazy                  as LT (Text ())
import           Data.Traversable                as X (forM)
import           Data.Typeable                   as X

import qualified GHC.Show                        as Show

import           Prelude                         as X hiding (all, and, any,
                                                       break, concat, concatMap,
                                                       drop, dropWhile, elem,
                                                       filter, foldMap, foldr,
                                                       getLine, length, lines,
                                                       log, lookup, notElem,
                                                       null, or, product,
                                                       readFile, replicate,
                                                       reverse, sequence_, show,
                                                       span, splitAt, sum, take,
                                                       takeWhile, unlines,
                                                       unwords, words,
                                                       writeFile)

import           System.IO                       as X (stderr, stdout)

import           Text.PrettyPrint.ANSI.Leijen    as X (Doc, Pretty (..), angles,
                                                       brackets, equals, hsep,
                                                       indent, space, text,
                                                       vsep, (<+>))

import           Text.PrettyPrint.ANSI.Leijen    (line)
-- }}}

-- * Free monad utilities

-- | Right-associative tuple type-constructor
type a ::: b = (a, b)
infixr 0 :::

-- | Right-associative tuple data-constructor
(>:) :: a -> b -> (a,b)
(>:) a b = (a, b)
infixr 0 >:

(*:*) :: (Functor f, Functor g) => (a -> f a) -> (b -> g b) -> (a, b) -> (f :*: g) (a, b)
(*:*) f g (a,b) = ((,b) <$> f a) :*: ((a,) <$> g b)
infixr 0 *:*


class (Monad m, Functor f, Functor g) => PairingM f g m | f -> g where
  pairM :: (a -> b -> m r) -> f a -> g b -> m r

instance (Monad m) => PairingM Identity Identity m where
  pairM f (Identity a) (Identity b) = f a b

instance (PairingM f f' m, PairingM g g' m) => PairingM (f :+: g) (f' :*: g') m where
  pairM p (Inl x) (a :*: _) = pairM p x a
  pairM p (Inr x) (_ :*: b) = pairM p x b

instance (PairingM f f' m, PairingM g g' m) => PairingM (f :*: g) (f' :+: g') m where
  pairM p (a :*: _) (Inl x) = pairM p a x
  pairM p (_ :*: b) (Inr x) = pairM p b x

interpret :: (PairingM f g m) => (a -> b -> m r) -> Cofree f a -> FreeT g m b -> m r
interpret p eval program = do
  let a = extract eval
  b <- runFreeT program
  case b of
    Pure x -> p a x
    Free gs -> pairM (interpret p) (unwrap eval) gs

-- * Shortcuts

type LByteString = LB.ByteString
type ByteString = B.ByteString
type LText = LT.Text
type Text = T.Text

-- | Generic 'Show.show'
show :: (Show a, IsString b) => a -> b
show = fromString . Show.show

-- | Shortcut to 'liftIO'
io :: MonadIO m => IO a -> m a
io = liftIO

-- | Infix operator for 'line'
(<++>) :: Doc -> Doc -> Doc
x <++> y = x <> line <> y