{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -Wall -Wno-name-shadowing #-}

module Data.IFunctor.IFree
    ( IFree (..)
    ) where

import           Data.IFunctor         (IFunctor (..))
import           Data.IFunctor.Classes
import           Data.IMonad           (IMonad (..))
import           Data.ITraversable     (ITraversable (..))
import           Data.Typeable         (Typeable)
import           GHC.Generics          (Generic, Generic1)
import           Singlethongs          (SingI)
import           Text.Read

-- | Free IMonad
data IFree f a ix = IPure (a ix)
    | IFree (f (IFree f a) ix)
    deriving (Typeable, (forall x. IFree f a ix -> Rep (IFree f a ix) x)
-> (forall x. Rep (IFree f a ix) x -> IFree f a ix)
-> Generic (IFree f a ix)
forall x. Rep (IFree f a ix) x -> IFree f a ix
forall x. IFree f a ix -> Rep (IFree f a ix) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k) x.
Rep (IFree f a ix) x -> IFree f a ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k) x.
IFree f a ix -> Rep (IFree f a ix) x
$cto :: forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k) x.
Rep (IFree f a ix) x -> IFree f a ix
$cfrom :: forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k) x.
IFree f a ix -> Rep (IFree f a ix) x
Generic, (forall (a :: k). IFree f a a -> Rep1 (IFree f a) a)
-> (forall (a :: k). Rep1 (IFree f a) a -> IFree f a a)
-> Generic1 (IFree f a)
forall (a :: k). Rep1 (IFree f a) a -> IFree f a a
forall (a :: k). IFree f a a -> Rep1 (IFree f a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (a :: k).
Rep1 (IFree f a) a -> IFree f a a
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (a :: k).
IFree f a a -> Rep1 (IFree f a) a
$cto1 :: forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (a :: k).
Rep1 (IFree f a) a -> IFree f a a
$cfrom1 :: forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (a :: k).
IFree f a a -> Rep1 (IFree f a) a
Generic1)

instance IFunctor f => IFunctor (IFree f) where
    imap :: (a ~~> b) -> IFree f a ~~> IFree f b
imap f :: a ~~> b
f (IPure x :: a ix
x) = b ix -> IFree f b ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
a ix -> IFree f a ix
IPure (a ix -> b ix
a ~~> b
f a ix
x)
    imap f :: a ~~> b
f (IFree x :: f (IFree f a) ix
x) = f (IFree f b) ix -> IFree f b ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
f (IFree f a) ix -> IFree f a ix
IFree ((IFree f a ~~> IFree f b) -> f (IFree f a) ix -> f (IFree f b) ix
forall k k (f :: (k -> *) -> k -> *) (a :: k -> *) (b :: k -> *).
IFunctor f =>
(a ~~> b) -> f a ~~> f b
imap ((a ~~> b) -> IFree f a ~~> IFree f b
forall k k (f :: (k -> *) -> k -> *) (a :: k -> *) (b :: k -> *).
IFunctor f =>
(a ~~> b) -> f a ~~> f b
imap a ~~> b
f) f (IFree f a) ix
x)

instance ITraversable f => ITraversable (IFree f) where
    itraverse :: (forall (ix :: k). SingI ix => a ix -> m (b ix))
-> IFree f a ix -> m (IFree f b ix)
itraverse f :: forall (ix :: k). SingI ix => a ix -> m (b ix)
f (IPure x :: a ix
x) = b ix -> IFree f b ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
a ix -> IFree f a ix
IPure (b ix -> IFree f b ix) -> m (b ix) -> m (IFree f b ix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a ix -> m (b ix)
forall (ix :: k). SingI ix => a ix -> m (b ix)
f a ix
x
    itraverse f :: forall (ix :: k). SingI ix => a ix -> m (b ix)
f (IFree x :: f (IFree f a) ix
x) = f (IFree f b) ix -> IFree f b ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
f (IFree f a) ix -> IFree f a ix
IFree (f (IFree f b) ix -> IFree f b ix)
-> m (f (IFree f b) ix) -> m (IFree f b ix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (ix :: k). SingI ix => IFree f a ix -> m (IFree f b ix))
-> f (IFree f a) ix -> m (f (IFree f b) ix)
forall k k (f :: (k -> *) -> k -> *) (m :: * -> *) (ix :: k)
       (a :: k -> *) (b :: k -> *).
(ITraversable f, Applicative m, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> m (b ix))
-> f a ix -> m (f b ix)
itraverse ((forall (ix :: k). SingI ix => a ix -> m (b ix))
-> IFree f a ix -> m (IFree f b ix)
forall k k (f :: (k -> *) -> k -> *) (m :: * -> *) (ix :: k)
       (a :: k -> *) (b :: k -> *).
(ITraversable f, Applicative m, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> m (b ix))
-> f a ix -> m (f b ix)
itraverse forall (ix :: k). SingI ix => a ix -> m (b ix)
f) f (IFree f a) ix
x

instance IFunctor f => IMonad (IFree f) where
    ipure :: a ix -> IFree f a ix
ipure = a ix -> IFree f a ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
a ix -> IFree f a ix
IPure
    ijoin :: IFree f (IFree f a) ix -> IFree f a ix
ijoin (IPure x :: IFree f a ix
x) = IFree f a ix
x
    ijoin (IFree x :: f (IFree f (IFree f a)) ix
x) = f (IFree f a) ix -> IFree f a ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
f (IFree f a) ix -> IFree f a ix
IFree (f (IFree f a) ix -> IFree f a ix)
-> f (IFree f a) ix -> IFree f a ix
forall a b. (a -> b) -> a -> b
$ (IFree f (IFree f a) ~~> IFree f a)
-> f (IFree f (IFree f a)) ix -> f (IFree f a) ix
forall k k (f :: (k -> *) -> k -> *) (a :: k -> *) (b :: k -> *).
IFunctor f =>
(a ~~> b) -> f a ~~> f b
imap IFree f (IFree f a) ~~> IFree f a
forall k (f :: (k -> *) -> k -> *) (a :: k -> *).
IMonad f =>
f (f a) ~~> f a
ijoin f (IFree f (IFree f a)) ix
x
    ibind :: (a ~~> IFree f b) -> IFree f a ~~> IFree f b
ibind f :: a ~~> IFree f b
f (IPure x :: a ix
x) = a ix -> IFree f b ix
a ~~> IFree f b
f a ix
x
    ibind f :: a ~~> IFree f b
f (IFree x :: f (IFree f a) ix
x) = f (IFree f b) ix -> IFree f b ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
f (IFree f a) ix -> IFree f a ix
IFree (f (IFree f b) ix -> IFree f b ix)
-> f (IFree f b) ix -> IFree f b ix
forall a b. (a -> b) -> a -> b
$ (IFree f a ~~> IFree f b) -> f (IFree f a) ix -> f (IFree f b) ix
forall k k (f :: (k -> *) -> k -> *) (a :: k -> *) (b :: k -> *).
IFunctor f =>
(a ~~> b) -> f a ~~> f b
imap ((a ~~> IFree f b) -> IFree f a ~~> IFree f b
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (b :: k -> *).
IMonad f =>
(a ~~> f b) -> f a ~~> f b
ibind a ~~> IFree f b
f) f (IFree f a) ix
x

instance IShow f => IShow (IFree f) where
    ishowsPrec :: (forall (ix :: k). SingI ix => Int -> a ix -> ShowS)
-> Int -> IFree f a ix -> ShowS
ishowsPrec sp :: forall (ix :: k). SingI ix => Int -> a ix -> ShowS
sp p :: Int
p (IPure x :: a ix
x) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString "IPure " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a ix -> ShowS
forall (ix :: k). SingI ix => Int -> a ix -> ShowS
sp 11 a ix
x
    ishowsPrec sp :: forall (ix :: k). SingI ix => Int -> a ix -> ShowS
sp p :: Int
p (IFree x :: f (IFree f a) ix
x) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString "IFree " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall (ix :: k). SingI ix => Int -> IFree f a ix -> ShowS)
-> Int -> f (IFree f a) ix -> ShowS
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IShow f, SingI ix) =>
(forall (ix :: k). SingI ix => Int -> a ix -> ShowS)
-> Int -> f a ix -> ShowS
ishowsPrec ((forall (ix :: k). SingI ix => Int -> a ix -> ShowS)
-> Int -> IFree f a ix -> ShowS
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IShow f, SingI ix) =>
(forall (ix :: k). SingI ix => Int -> a ix -> ShowS)
-> Int -> f a ix -> ShowS
ishowsPrec forall (ix :: k). SingI ix => Int -> a ix -> ShowS
sp)) 11 f (IFree f a) ix
x

instance IRead f => IRead (IFree f) where
    ireadPrec :: (forall (ix :: k). SingI ix => ReadPrec (a ix))
-> ReadPrec (IFree f a ix)
ireadPrec rp :: forall (ix :: k). SingI ix => ReadPrec (a ix)
rp = ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix))
-> ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a b. (a -> b) -> a -> b
$
        (Int -> ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix))
-> ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a b. (a -> b) -> a -> b
$ do
            Ident "IPure" <- ReadPrec Lexeme
lexP
            a ix
x <- ReadPrec (a ix) -> ReadPrec (a ix)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (a ix)
forall (ix :: k). SingI ix => ReadPrec (a ix)
rp
            IFree f a ix -> ReadPrec (IFree f a ix)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IFree f a ix -> ReadPrec (IFree f a ix))
-> IFree f a ix -> ReadPrec (IFree f a ix)
forall a b. (a -> b) -> a -> b
$ a ix -> IFree f a ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
a ix -> IFree f a ix
IPure a ix
x
        )
        ReadPrec (IFree f a ix)
-> ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
        (Int -> ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix))
-> ReadPrec (IFree f a ix) -> ReadPrec (IFree f a ix)
forall a b. (a -> b) -> a -> b
$ do
            Ident "IFree" <- ReadPrec Lexeme
lexP
            f (IFree f a) ix
x <- ReadPrec (f (IFree f a) ix) -> ReadPrec (f (IFree f a) ix)
forall a. ReadPrec a -> ReadPrec a
step ((forall (ix :: k). SingI ix => ReadPrec (IFree f a ix))
-> ReadPrec (f (IFree f a) ix)
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IRead f, SingI ix) =>
(forall (ix :: k). SingI ix => ReadPrec (a ix))
-> ReadPrec (f a ix)
ireadPrec ((forall (ix :: k). SingI ix => ReadPrec (a ix))
-> ReadPrec (IFree f a ix)
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IRead f, SingI ix) =>
(forall (ix :: k). SingI ix => ReadPrec (a ix))
-> ReadPrec (f a ix)
ireadPrec forall (ix :: k). SingI ix => ReadPrec (a ix)
rp))
            IFree f a ix -> ReadPrec (IFree f a ix)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IFree f a ix -> ReadPrec (IFree f a ix))
-> IFree f a ix -> ReadPrec (IFree f a ix)
forall a b. (a -> b) -> a -> b
$ f (IFree f a) ix -> IFree f a ix
forall k (f :: (k -> *) -> k -> *) (a :: k -> *) (ix :: k).
f (IFree f a) ix -> IFree f a ix
IFree f (IFree f a) ix
x
        )

instance IEq f => IEq (IFree f) where
    ieq :: (forall (ix :: k). SingI ix => a ix -> a ix -> Bool)
-> IFree f a ix -> IFree f a ix -> Bool
ieq eq :: forall (ix :: k). SingI ix => a ix -> a ix -> Bool
eq (IPure x :: a ix
x) (IPure y :: a ix
y) = a ix -> a ix -> Bool
forall (ix :: k). SingI ix => a ix -> a ix -> Bool
eq a ix
x a ix
y
    ieq eq :: forall (ix :: k). SingI ix => a ix -> a ix -> Bool
eq (IFree x :: f (IFree f a) ix
x) (IFree y :: f (IFree f a) ix
y) = (forall (ix :: k).
 SingI ix =>
 IFree f a ix -> IFree f a ix -> Bool)
-> f (IFree f a) ix -> f (IFree f a) ix -> Bool
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IEq f, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> a ix -> Bool)
-> f a ix -> f a ix -> Bool
ieq ((forall (ix :: k). SingI ix => a ix -> a ix -> Bool)
-> IFree f a ix -> IFree f a ix -> Bool
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IEq f, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> a ix -> Bool)
-> f a ix -> f a ix -> Bool
ieq forall (ix :: k). SingI ix => a ix -> a ix -> Bool
eq) f (IFree f a) ix
x f (IFree f a) ix
y
    ieq _ _ _                  = Bool
False

instance IOrd f => IOrd (IFree f) where
    icompare :: (forall (ix :: k). SingI ix => a ix -> a ix -> Ordering)
-> IFree f a ix -> IFree f a ix -> Ordering
icompare comp :: forall (ix :: k). SingI ix => a ix -> a ix -> Ordering
comp (IPure x :: a ix
x) (IPure y :: a ix
y) = a ix -> a ix -> Ordering
forall (ix :: k). SingI ix => a ix -> a ix -> Ordering
comp a ix
x a ix
y
    icompare comp :: forall (ix :: k). SingI ix => a ix -> a ix -> Ordering
comp (IFree x :: f (IFree f a) ix
x) (IFree y :: f (IFree f a) ix
y) = (forall (ix :: k).
 SingI ix =>
 IFree f a ix -> IFree f a ix -> Ordering)
-> f (IFree f a) ix -> f (IFree f a) ix -> Ordering
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IOrd f, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> a ix -> Ordering)
-> f a ix -> f a ix -> Ordering
icompare ((forall (ix :: k). SingI ix => a ix -> a ix -> Ordering)
-> IFree f a ix -> IFree f a ix -> Ordering
forall k k (f :: (k -> *) -> k -> *) (ix :: k) (a :: k -> *).
(IOrd f, SingI ix) =>
(forall (ix :: k). SingI ix => a ix -> a ix -> Ordering)
-> f a ix -> f a ix -> Ordering
icompare forall (ix :: k). SingI ix => a ix -> a ix -> Ordering
comp) f (IFree f a) ix
x f (IFree f a) ix
y
    icompare _ (IPure _) (IFree _)    = Ordering
LT
    icompare _ (IFree _) (IPure _)    = Ordering
GT

instance (IShow f, IShow2 a, SingI ix) => Show (IFree f a ix) where
    showsPrec :: Int -> IFree f a ix -> ShowS
showsPrec = Int -> IFree f a ix -> ShowS
forall k1 k2 (f :: (k1 -> *) -> k2 -> *) (a :: k1 -> *) (ix :: k2).
(IShow f, IShow2 a, SingI ix) =>
Int -> f a ix -> ShowS
ishowsPrec1

instance (IRead f, IRead2 a, SingI ix) => Read (IFree f a ix) where
    readPrec :: ReadPrec (IFree f a ix)
readPrec = ReadPrec (IFree f a ix)
forall k1 k2 (f :: (k1 -> *) -> k2 -> *) (a :: k1 -> *) (ix :: k2).
(IRead f, IRead2 a, SingI ix) =>
ReadPrec (f a ix)
ireadPrec1

instance (IEq f, IEq2 a, SingI ix) => Eq (IFree f a ix) where
    == :: IFree f a ix -> IFree f a ix -> Bool
(==) = IFree f a ix -> IFree f a ix -> Bool
forall k1 k2 (f :: (k1 -> *) -> k2 -> *) (a :: k1 -> *) (ix :: k2).
(IEq f, IEq2 a, SingI ix) =>
f a ix -> f a ix -> Bool
ieq1

instance (IOrd f, IOrd2 a, SingI ix) => Ord (IFree f a ix) where
    compare :: IFree f a ix -> IFree f a ix -> Ordering
compare = IFree f a ix -> IFree f a ix -> Ordering
forall k1 k2 (f :: (k1 -> *) -> k2 -> *) (a :: k1 -> *) (ix :: k2).
(IOrd f, IOrd2 a, SingI ix) =>
f a ix -> f a ix -> Ordering
icompare1