--
--  Control.Concurrent.Session :: Session Types for Haskell
--  Copyright (C) 2007  Matthew Sackman (matthew@wellquite.org)
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this library; if not, write to the Free Software
--  Foundation, Inc., 59 Temple Place, Suite 330, Boston,
--  MA  02111-1307  USA
--
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}

module Control.Concurrent.Session.BaseClasses
    where

import Control.Concurrent.Session.BaseTypes
import Control.Concurrent.Session.ExtraClasses
import Control.Concurrent.Session.List

class DualT a b | a -> b, b -> a where
    dual :: a -> b

instance DualT (SessionSpec EndT) (SessionSpec EndT) where
    dual EndS = EndS
instance DualT (SessionSpec LoopEndT) (SessionSpec LoopEndT) where
    dual LoopEndS = LoopEndS
instance (DualT (SessionSpec l) (SessionSpec r)) =>
    DualT (SessionSpec (RecvT t l)) (SessionSpec (SendT t r)) where
        dual (RecvS t n) = (SendS t (dual n))
instance (DualT (SessionSpec l) (SessionSpec r)) =>
    DualT (SessionSpec (SendT t l)) (SessionSpec (RecvT t r)) where
        dual (SendS t n) = (RecvS t (dual n))
instance (DualT (SessionSpec l) (SessionSpec r)) =>
    DualT (SessionSpec (LoopT (SessionSpec l))) (SessionSpec (LoopT (SessionSpec r))) where
        dual (LoopS l) = LoopS (dual l)
instance (DualT (List t anyof) (List t oneof), SpecList t anyof, SpecList t oneof) =>
    DualT (SessionSpec (OfferT (List t anyof))) (SessionSpec (SelectT (List t oneof))) where
        dual (OfferS list) = SelectS (dual list)
instance (DualT (List t oneof) (List t anyof), SpecList t anyof, SpecList t oneof) =>
    DualT (SessionSpec (SelectT (List t oneof))) (SessionSpec (OfferT (List t anyof))) where
        dual (SelectS list) = OfferS (dual list)

instance (DualT l r) =>
    DualT (List t l) (List t r) where
        dual (List t a) = List t (dual a)
instance DualT (Nil) (Nil) where
    dual Nil = nil
instance (DualT (SessionSpec ltype) (SessionSpec rtype), DualT ltail rtail,
          ListLength ltail len, ListLength rtail len) =>
    DualT (Cons (SessionSpec ltype) ltail) (Cons (SessionSpec rtype) rtail) where
        dual lst = cons (dual val) (dual nxt)
            where
              (val, nxt) = decomposeCons lst

class MatchAnyChoice choice match where
    findAnyMatch :: choice -> match
instance MatchAnyChoice (Cons (SessionSpec a) ns) (SessionSpec a) where
    findAnyMatch = fst . decomposeCons
instance (MatchAnyChoice ns (SessionSpec a)) =>
    MatchAnyChoice (Cons (SessionSpec x) ns) (SessionSpec a) where
        findAnyMatch = findAnyMatch . snd . decomposeCons

class BuildReductionList lstLoop a b | lstLoop a -> b where
    findReduction :: lstLoop -> a -> b
class BuildReductionListPrimitives lstLoop a b | lstLoop a -> b where
    findReductionPrim :: lstLoop -> a -> b

instance BuildReductionListPrimitives lstLoop (SessionSpec EndT) (Cons (SessionSpec EndT) Nil) where
    findReductionPrim _ spec = cons spec nil
instance BuildReductionListPrimitives lstLoop (SessionSpec LoopEndT) (Cons (SessionSpec LoopEndT) Nil) where
    findReductionPrim _ spec = cons spec nil
instance (BuildReductionList lstLoop (SessionSpec n) (Cons val nxt),
          ListLength (Cons val nxt) (Succ len),
          ListLength nxt len) =>
    BuildReductionListPrimitives lstLoop (SessionSpec (SendT t n)) (Cons (SessionSpec (SendT t n)) (Cons val nxt)) where
        findReductionPrim lastSeenLoop (SendS t spec) = let nxt = findReduction lastSeenLoop spec in cons (SendS t spec) nxt
instance (BuildReductionList lstLoop (SessionSpec n) (Cons val nxt),
          ListLength (Cons val nxt) (Succ len),
          ListLength nxt len) =>
    BuildReductionListPrimitives lstLoop (SessionSpec (RecvT t n)) (Cons (SessionSpec (RecvT t n)) (Cons val nxt)) where
        findReductionPrim lastSeenLoop (RecvS t spec) = let nxt = findReduction lastSeenLoop spec in cons (RecvS t spec) nxt
instance (BuildReductionList lstLoop (SessionSpec n) (Cons val nxt),
          ListLength (Cons val nxt) (Succ len),
          ListLength nxt len) =>
    BuildReductionListPrimitives lstLoop (SessionSpec (SessT t n)) (Cons (SessionSpec (SessT t n)) (Cons val nxt)) where
        findReductionPrim = undefined

-- anything else!
instance (BuildReductionListPrimitives lstLoop a b) =>
    BuildReductionList lstLoop a b where
        findReduction = findReductionPrim

-- no instances here
class ZeroOrMoreSteps a b where
    stepN :: a -> b

class JustSendsRecvs orig sends recvs | orig -> sends, orig -> recvs, orig -> sends recvs
instance JustSendsRecvs (SessionSpec EndT) (SessionSpec EndT) (SessionSpec EndT)
instance JustSendsRecvs (SessionSpec LoopEndT) (SessionSpec LoopEndT) (SessionSpec LoopEndT)
instance (JustSendsRecvs (SessionSpec n) (SessionSpec s) (SessionSpec r)) =>
    JustSendsRecvs (SessionSpec (SendT t n)) (SessionSpec (SessT t s)) (SessionSpec r)
instance (JustSendsRecvs (SessionSpec n) (SessionSpec s) (SessionSpec r)) =>
    JustSendsRecvs (SessionSpec (RecvT t n)) (SessionSpec s) (SessionSpec (SessT t r))