--
--  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 #-}

module Control.Concurrent.Session.BaseTypes
    where

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

data SType :: * -> * where
              IntS    :: SType Int
              BoolS   :: SType Bool
              CharS   :: SType Char
              StringS :: SType String
              FloatS  :: SType Float
              DoubleS :: SType Double
              AnyS    :: SType a
              LiftS   :: a -> SType a
              ListS   :: (SType a) -> SType [a]

instance Show (SType a) where
    show IntS      = "IntS"
    show BoolS     = "BoolS"
    show CharS     = "CharS"
    show StringS   = "StringS"
    show FloatS    = "FloatS"
    show DoubleS   = "DoubleS"
    show AnyS      = "AnyS"
    show (LiftS a) = "LiftS"
    show (ListS a) = "ListS of " ++ (show a)

data SendT a n
data RecvT a n
data EndT
data LoopEndT
data SessT a n
data LoopT l
data OfferT choices
data SelectT choices
data SessChoiceT choices

data SessionSpec :: * -> * where
                    RecvS :: (SType t) -> (SessionSpec n) -> SessionSpec (RecvT t n)
                    SendS :: (SType t) -> (SessionSpec n) -> SessionSpec (SendT t n)
                    EndS :: SessionSpec EndT
                    LoopEndS :: SessionSpec LoopEndT
                    LoopS :: (SessionSpec l) -> SessionSpec (LoopT (SessionSpec l))
                    OfferS :: (SpecList generalType specList) => (List generalType specList) -> SessionSpec (OfferT (List generalType specList))
                    SelectS :: (SpecList generalType specList) => (List generalType specList) -> SessionSpec (SelectT (List generalType specList))

instance (Show (SessionSpec next)) => Show (SessionSpec (RecvT t next)) where
    show (RecvS t next) = "RecvS " ++ (show t) ++ " . " ++ (show next)
instance (Show (SessionSpec next)) => Show (SessionSpec (SendT t next)) where
    show (SendS t next) = "SendS " ++ (show t) ++ " . " ++ (show next)
instance Show (SessionSpec EndT) where
    show (EndS) = "EndS"
instance Show (SessionSpec LoopEndT) where
    show (LoopEndS) = "LoopEndS"
instance (Show (SessionSpec l)) => Show (SessionSpec (LoopT (SessionSpec l))) where
    show (LoopS l) = "LoopS {" ++ (show l) ++ "}"
instance (Show specList) => Show (SessionSpec (OfferT (List generalType specList))) where
    show (OfferS list) = "Offer any of {" ++ (show list) ++ "}"
instance (Show specList) => Show (SessionSpec (SelectT (List generalType specList))) where
    show (SelectS list) = "Select one of {" ++ (show list) ++ "}"