content: {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
  {- |
  Module      :  ./Common/ATerm/ConvInstances.hs
  Description :  special ShATermConvertible instances
  Copyright   :  (c) Klaus Luettich, C. Maeder, Uni Bremen 2005-2006
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  Christian.Maeder@dfki.de
  Stability   :  provisional
  Portability :  non-portable (overlapping Typeable instances)
  
  This module provides instances of `ShATermConvertible`.
  -}
  
  module Common.ATerm.ConvInstances () where
  
  import ATerm.Lib
  import Common.Lib.SizedList as SizedList
  import qualified Common.Lib.Rel as Rel
  import qualified Common.Lib.MapSet as MapSet
  import qualified Common.InjMap as InjMap
  import Data.Typeable
  import Data.Time (TimeOfDay (..))
  import Data.Fixed (Pico)
  import Data.Ratio (Ratio)
  import System.Time
  
  instance ShATermConvertible a => ShATermConvertible (SizedList.SizedList a)
      where
    toShATermAux att0 = toShATermAux att0 . SizedList.toList
    fromShATermAux ix att0 = case fromShATermAux ix att0 of
      (att, l) -> (att, SizedList.fromList l)
  
  instance (Ord a, ShATermConvertible a, Ord b, ShATermConvertible b)
       => ShATermConvertible (InjMap.InjMap a b) where
    toShATermAux att0 x = do
          (att1, a') <- toShATerm' att0 $ InjMap.getAToB x
          (att2, b') <- toShATerm' att1 $ InjMap.getBToA x
          return $ addATerm (ShAAppl "InjMap" [a', b'] []) att2
    fromShATermAux ix att0 = case getShATerm ix att0 of
      ShAAppl "InjMap" [a, b] _ ->
          case fromShATerm' a att0 of { (att1, a') ->
          case fromShATerm' b att1 of { (att2, b') ->
          (att2, InjMap.unsafeConstructInjMap a' b') }}
      u -> fromShATermError "InjMap" u
  
  instance (Ord a, ShATermConvertible a, Ord b, ShATermConvertible b)
    => ShATermConvertible (MapSet.MapSet a b) where
    toShATermAux att0 r = do
          (att1, a') <- toShATerm' att0 $ MapSet.toMap r
          return $ addATerm (ShAAppl "MapSet" [a'] []) att1
    fromShATermAux ix att0 = case getShATerm ix att0 of
      ShAAppl "MapSet" [a] _ ->
          case fromShATerm' a att0 of { (att1, a') ->
          (att1, MapSet.fromDistinctMap a') }
      u -> fromShATermError "MapSet" u
  
  instance (Ord a, ShATermConvertible a) => ShATermConvertible (Rel.Rel a) where
    toShATermAux att0 r = do
          (att1, a') <- toShATerm' att0 $ Rel.toMap r
          return $ addATerm (ShAAppl "Rel" [a'] []) att1
    fromShATermAux ix att0 = case getShATerm ix att0 of
      ShAAppl "Rel" [a] _ ->
          case fromShATerm' a att0 of { (att1, a') ->
          (att1, Rel.fromMap a') }
      u -> fromShATermError "Rel" u
  
  deriving instance Typeable ClockTime
  
  instance ShATermConvertible ClockTime where
      toShATermAux att0 (TOD a b) = do
          (att1, a') <- toShATerm' att0 a
          (att2, b') <- toShATerm' att1 b
          return $ addATerm (ShAAppl "TOD" [a', b'] []) att2
      fromShATermAux ix att0 = case getShATerm ix att0 of
              ShAAppl "TOD" [a, b] _ ->
                      case fromShATerm' a att0 of { (att1, a') ->
                      case fromShATerm' b att1 of { (att2, b') ->
                      (att2, TOD a' b') }}
              u -> fromShATermError "ClockTime" u
  
  instance ShATermConvertible Double where
      toShATermAux att = toShATermAux att . toRational
      fromShATermAux ix att0 = case fromShATermAux ix att0 of
         (att, r) -> (att, fromRational r)
  
  instance ShATermConvertible TimeOfDay where
      toShATermAux att0 (TimeOfDay a b c) = do
          (att1, a') <- toShATerm' att0 a
          (att2, b') <- toShATerm' att1 b
          (att3, c') <- toShATerm' att2 (toRational c :: Rational)
          return $ addATerm (ShAAppl "TimeOfDay" [a', b', c'] []) att3
      fromShATermAux ix att0 = case getShATerm ix att0 of
              ShAAppl "TimeOfDay" [a, b, c] _ ->
                      case fromShATerm' a att0 of { (att1, a') ->
                      case fromShATerm' b att1 of { (att2, b') ->
                      case fromShATerm' c att2 of { (att3, c') ->
                      (att3, TimeOfDay a' b'
                       $ (fromRational :: Ratio Integer -> Pico) c') }}}
              u -> fromShATermError "TimeOfDay" u
  
  instance ShATermConvertible Ordering where
      toShATermAux att = toShATermAux att . ordToInt
      fromShATermAux ix att0 = case fromShATermAux ix att0 of
         (att, i) -> (att, ordFromInt i)
  
  ordFromInt :: Int -> Ordering
  ordFromInt 0 = LT
  ordFromInt 1 = EQ
  ordFromInt 2 = GT
  ordFromInt i = error $ "ordFromInt: only values from 0 to 2 allowed but got "
                 ++ show i
  
  ordToInt :: Ordering -> Int
  ordToInt LT = 0
  ordToInt EQ = 1
  ordToInt GT = 2
  