{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, StandaloneDeriving, DeriveDataTypeable, Trustworthy #-}

module Data.Columbia.Orphans (LazyFix(LazyFix)) where

import Data.Typeable
import Generics.Pointless.Functors
import Data.Generics.SYB.WithClass.Basics
import Data.Columbia.RWInstances
import Data.Array.Unboxed

idConstr = Constr(AlgConstr 1) "IdF" [] Prefix idDataType
idDataType = DataType "Generics.Pointless.Functors" (AlgRep[idConstr])
instance (Sat(ctx(Id x)), Data ctx x) => Data ctx(Id x) where
	gfoldl _ o f (IdF x) = f IdF `o` x
	gunfold _ k f _ = k(f IdF)
	dataTypeOf _ _ = idDataType
	toConstr _ _ = idConstr

constConstr = Constr(AlgConstr 1) "ConsF" [] Prefix idDataType
constDataType = DataType "Generics.Pointless.Functors" (AlgRep[constConstr])
instance (Sat(ctx(Const t x)), Data ctx t, Typeable x) => Data ctx(Const t x) where
	gfoldl _ o f (ConsF x) = f ConsF `o` x
	gunfold _ k f _ = k(f ConsF)
	dataTypeOf _ _ = constDataType
	toConstr _ _ = constConstr

sumConstr1 = Constr(AlgConstr 1) "InlF" [] Prefix sumDataType
sumConstr2 = Constr(AlgConstr 2) "InrF" [] Prefix sumDataType
sumDataType = DataType "Generics.Pointless.Functors" (AlgRep[sumConstr1,sumConstr2])
instance (Sat(ctx((:+:) g h x)), Typeable1 g, Typeable1 h, Typeable x, Data ctx(g x), Data ctx(h x)) => Data ctx((:+:) g h x) where
	gfoldl _ o f (InlF x) = f InlF `o` x
	gfoldl _ o f (InrF x) = f InrF `o` x
	gunfold _ k f constr = case constrIndex constr of
		1 -> k(f InlF)
		2 -> k(f InrF)
		_ -> error"Data: unrecognized constructor index"

prodConstr = Constr(AlgConstr 1) "ProdF" [] Prefix prodDataType
prodDataType = DataType "Generics.Pointless.Functors" (AlgRep[prodConstr])
instance (Sat(ctx((:*:) g h x)), Typeable1 g, Typeable1 h, Typeable x, Data ctx(g x), Data ctx(h x)) => Data ctx((:*:) g h x) where
	gfoldl _ o f (ProdF x x2) = f ProdF `o` x `o` x2
	gunfold _ k f _ = k(k(f ProdF))
	dataTypeOf _ _ = prodDataType
	toConstr _ _ = prodConstr

instance (Sat(ctx((:@:) g h x)), Typeable1 g, Typeable1 h, Typeable x, Data ctx(g(h x))) => Data ctx((:@:) g h x) where
	gfoldl _ o f (CompF x) = f CompF `o` x

fixConstr = Constr(AlgConstr 1) "Inn" [] Prefix fixDataType
fixDataType = DataType "Generics.Pointless.Functors" (AlgRep[fixConstr])
instance (Sat(ctx(Fix f)), Typeable1 f, Data ctx(Rep f(Fix f))) => Data ctx(Fix f) where
	gfoldl _ o f (Inn x) = f Inn `o` x
	gunfold _ k f _ = k(f Inn)
	dataTypeOf _ _ = fixDataType
	toConstr _ _ = fixConstr

instance (Typeable1 f) => RW(Fix f)

deriving instance (Eq(Rep f(Fix f))) => Eq(Fix f)

deriving instance (Ord(Rep f(Fix f))) => Ord(Fix f)

data LazyFix f = LazyFix(Rep f(LazyFix f))

deriving instance (Typeable1 f) => Typeable(LazyFix f)

deriving instance (Eq(Rep f(LazyFix f))) => Eq(LazyFix f)

deriving instance (Ord(Rep f(LazyFix f))) => Ord(LazyFix f)

deriving instance (Show(Rep f(LazyFix f))) => Show(LazyFix f)

deriving instance (Read(Rep f(LazyFix f))) => Read(LazyFix f)

lazyFixConstr = Constr(AlgConstr 1) "LazyFix" [] Prefix lazyFixDataType
lazyFixDataType = DataType "Generics.Pointless.Functors" (AlgRep[lazyFixConstr])
instance (Sat(ctx(LazyFix f)), Typeable1 f, Data ctx(Rep f(LazyFix f))) => Data ctx(LazyFix f) where
	gfoldl _ o f (LazyFix x) = f LazyFix `o` x
	gunfold _ k f _ = k(f LazyFix)
	dataTypeOf _ _ = lazyFixDataType
	toConstr _ _ = lazyFixConstr

instance (Typeable1 f) => RW(LazyFix f)

instance (Ix i, IArray UArray e, Sat(ctx(UArray i e)), Typeable i, Data ctx e, Sat(ctx[e])) => Data ctx(UArray i e) where
	gfoldl _ o f ua = f(listArray(bounds ua)) `o` elems ua
	gunfold = error"no gunfold"
	toConstr = error"no toConstr"
	dataTypeOf _ _ = mkNorepType"Data.Array.Unboxed.UArray"
	dataCast1 _ = gcast1