{-# 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 :: ATermTable -> SizedList a -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 = ATermTable -> [a] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATermAux ATermTable
att0 ([a] -> IO (ATermTable, Int))
-> (SizedList a -> [a]) -> SizedList a -> IO (ATermTable, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedList a -> [a]
forall a. SizedList a -> [a]
SizedList.toList
  fromShATermAux :: Int -> ATermTable -> (ATermTable, SizedList a)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> (ATermTable, [a])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATermAux Int
ix ATermTable
att0 of
    (att :: ATermTable
att, l :: [a]
l) -> (ATermTable
att, [a] -> SizedList a
forall a. [a] -> SizedList a
SizedList.fromList [a]
l)

instance (Ord a, ShATermConvertible a, Ord b, ShATermConvertible b)
     => ShATermConvertible (InjMap.InjMap a b) where
  toShATermAux :: ATermTable -> InjMap a b -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 x :: InjMap a b
x = do
        (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Map a b -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 (Map a b -> IO (ATermTable, Int))
-> Map a b -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ InjMap a b -> Map a b
forall a b. InjMap a b -> Map a b
InjMap.getAToB InjMap a b
x
        (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Map b a -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 (Map b a -> IO (ATermTable, Int))
-> Map b a -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ InjMap a b -> Map b a
forall a b. InjMap a b -> Map b a
InjMap.getBToA InjMap a b
x
        (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "InjMap" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, InjMap a b)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "InjMap" [a :: Int
a, b :: Int
b] _ ->
        case Int -> ATermTable -> (ATermTable, Map a b)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of { (att1 :: ATermTable
att1, a' :: Map a b
a') ->
        case Int -> ATermTable -> (ATermTable, Map b a)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of { (att2 :: ATermTable
att2, b' :: Map b a
b') ->
        (ATermTable
att2, Map a b -> Map b a -> InjMap a b
forall a b. Map a b -> Map b a -> InjMap a b
InjMap.unsafeConstructInjMap Map a b
a' Map b a
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, InjMap a b)
forall a. String -> ShATerm -> a
fromShATermError "InjMap" ShATerm
u

instance (Ord a, ShATermConvertible a, Ord b, ShATermConvertible b)
  => ShATermConvertible (MapSet.MapSet a b) where
  toShATermAux :: ATermTable -> MapSet a b -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 r :: MapSet a b
r = do
        (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Map a (Set b) -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 (Map a (Set b) -> IO (ATermTable, Int))
-> Map a (Set b) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ MapSet a b -> Map a (Set b)
forall a b. MapSet a b -> Map a (Set b)
MapSet.toMap MapSet a b
r
        (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "MapSet" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, MapSet a b)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "MapSet" [a :: Int
a] _ ->
        case Int -> ATermTable -> (ATermTable, Map a (Set b))
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of { (att1 :: ATermTable
att1, a' :: Map a (Set b)
a') ->
        (ATermTable
att1, Map a (Set b) -> MapSet a b
forall a b. Map a (Set b) -> MapSet a b
MapSet.fromDistinctMap Map a (Set b)
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, MapSet a b)
forall a. String -> ShATerm -> a
fromShATermError "MapSet" ShATerm
u

instance (Ord a, ShATermConvertible a) => ShATermConvertible (Rel.Rel a) where
  toShATermAux :: ATermTable -> Rel a -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 r :: Rel a
r = do
        (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Map a (Set a) -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 (Map a (Set a) -> IO (ATermTable, Int))
-> Map a (Set a) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
Rel.toMap Rel a
r
        (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Rel" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Rel a)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Rel" [a :: Int
a] _ ->
        case Int -> ATermTable -> (ATermTable, Map a (Set a))
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of { (att1 :: ATermTable
att1, a' :: Map a (Set a)
a') ->
        (ATermTable
att1, Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel.fromMap Map a (Set a)
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Rel a)
forall a. String -> ShATerm -> a
fromShATermError "Rel" ShATerm
u

deriving instance Typeable ClockTime

instance ShATermConvertible ClockTime where
    toShATermAux :: ATermTable -> ClockTime -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 (TOD a :: Integer
a b :: Integer
b) = do
        (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Integer -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Integer
a
        (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Integer -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Integer
b
        (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "TOD" [Int
a', Int
b'] []) ATermTable
att2
    fromShATermAux :: Int -> ATermTable -> (ATermTable, ClockTime)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
            ShAAppl "TOD" [a :: Int
a, b :: Int
b] _ ->
                    case Int -> ATermTable -> (ATermTable, Integer)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of { (att1 :: ATermTable
att1, a' :: Integer
a') ->
                    case Int -> ATermTable -> (ATermTable, Integer)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of { (att2 :: ATermTable
att2, b' :: Integer
b') ->
                    (ATermTable
att2, Integer -> Integer -> ClockTime
TOD Integer
a' Integer
b') }}
            u :: ShATerm
u -> String -> ShATerm -> (ATermTable, ClockTime)
forall a. String -> ShATerm -> a
fromShATermError "ClockTime" ShATerm
u

instance ShATermConvertible Double where
    toShATermAux :: ATermTable -> Double -> IO (ATermTable, Int)
toShATermAux att :: ATermTable
att = ATermTable -> Rational -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATermAux ATermTable
att (Rational -> IO (ATermTable, Int))
-> (Double -> Rational) -> Double -> IO (ATermTable, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
    fromShATermAux :: Int -> ATermTable -> (ATermTable, Double)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> (ATermTable, Rational)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATermAux Int
ix ATermTable
att0 of
       (att :: ATermTable
att, r :: Rational
r) -> (ATermTable
att, Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)

instance ShATermConvertible TimeOfDay where
    toShATermAux :: ATermTable -> TimeOfDay -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 (TimeOfDay a :: Int
a b :: Int
b c :: Pico
c) = do
        (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Int -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Int
a
        (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Int -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Int
b
        (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Rational -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 (Pico -> Rational
forall a. Real a => a -> Rational
toRational Pico
c :: Rational)
        (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "TimeOfDay" [Int
a', Int
b', Int
c'] []) ATermTable
att3
    fromShATermAux :: Int -> ATermTable -> (ATermTable, TimeOfDay)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
            ShAAppl "TimeOfDay" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
                    case Int -> ATermTable -> (ATermTable, Int)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of { (att1 :: ATermTable
att1, a' :: Int
a') ->
                    case Int -> ATermTable -> (ATermTable, Int)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of { (att2 :: ATermTable
att2, b' :: Int
b') ->
                    case Int -> ATermTable -> (ATermTable, Rational)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of { (att3 :: ATermTable
att3, c' :: Rational
c') ->
                    (ATermTable
att3, Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
a' Int
b'
                     (Pico -> TimeOfDay) -> Pico -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational :: Ratio Integer -> Pico) Rational
c') }}}
            u :: ShATerm
u -> String -> ShATerm -> (ATermTable, TimeOfDay)
forall a. String -> ShATerm -> a
fromShATermError "TimeOfDay" ShATerm
u

instance ShATermConvertible Ordering where
    toShATermAux :: ATermTable -> Ordering -> IO (ATermTable, Int)
toShATermAux att :: ATermTable
att = ATermTable -> Int -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATermAux ATermTable
att (Int -> IO (ATermTable, Int))
-> (Ordering -> Int) -> Ordering -> IO (ATermTable, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Int
ordToInt
    fromShATermAux :: Int -> ATermTable -> (ATermTable, Ordering)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> (ATermTable, Int)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATermAux Int
ix ATermTable
att0 of
       (att :: ATermTable
att, i :: Int
i) -> (ATermTable
att, Int -> Ordering
ordFromInt Int
i)

ordFromInt :: Int -> Ordering
ordFromInt :: Int -> Ordering
ordFromInt 0 = Ordering
LT
ordFromInt 1 = Ordering
EQ
ordFromInt 2 = Ordering
GT
ordFromInt i :: Int
i = String -> Ordering
forall a. HasCallStack => String -> a
error (String -> Ordering) -> String -> Ordering
forall a b. (a -> b) -> a -> b
$ "ordFromInt: only values from 0 to 2 allowed but got "
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

ordToInt :: Ordering -> Int
ordToInt :: Ordering -> Int
ordToInt LT = 0
ordToInt EQ = 1
ordToInt GT = 2