ConvInstances.hs revision ef9e8535c168d3f774d9e74368a2317a9eda5826
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder{-# OPTIONS -cpp #-}
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederModule : $Header$
25cc5fbba63f84b47e389af749f55abbbde71c8cChristian MaederDescription : special ShATermConvertible instances
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederCopyright : (c) Klaus Luettich, C. Maeder, Uni Bremen 2005-2006
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederMaintainer : Christian.Maeder@dfki.de
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederStability : provisional
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederPortability : non-portable (overlapping Typeable instances)
d8c71aacc9f1c8cd40a8ad8dcdad9be8854b849fChristian MaederThis module provides instances of `ShATermConvertible`.
c90087f49069855bf684b699f9ca1e2d65eac20bChristian Maederimport Common.Lib.SizedList as SizedList
96646aed2ae087b942ae23f15bbe729a8f7c43d3Christian Maederimport qualified Common.Lib.Rel as Rel
01e383014b555bbcf639c0ca60c5810b3eff83c0Christian Maederimport qualified Common.InjMap as InjMap
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maederimport Data.Time (TimeOfDay(..))
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder_tc_SizedListTc :: TyCon
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder_tc_SizedListTc = mkTyCon "Common.Lib.SizedList.SizedList"
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maederinstance Typeable1 SizedList where
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder typeOf1 _ = mkTyConApp _tc_SizedListTc []
2e2094a642e3775b0d76b890556407941d3a53b6Christian Maederinstance ShATermConvertible a => ShATermConvertible (SizedList.SizedList a)
2e2094a642e3775b0d76b890556407941d3a53b6Christian Maeder toShATermAux att0 = toShATermAux att0 . SizedList.toList
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder fromShATermAux ix att0 = case fromShATermAux ix att0 of
8410667510a76409aca9bb24ff0eda0420088274Christian Maeder (att, l) -> (att, SizedList.fromList l)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder_tc_InjMapTc :: TyCon
8410667510a76409aca9bb24ff0eda0420088274Christian Maeder_tc_InjMapTc = mkTyCon "Common.InjMap.InjMap"
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus Luettichinstance Typeable2 InjMap.InjMap where
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder typeOf2 _ = mkTyConApp _tc_InjMapTc []
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maederinstance (Ord a, ShATermConvertible a, Ord b, ShATermConvertible b)
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder => ShATermConvertible (InjMap.InjMap a b) where
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder toShATermAux att0 x = do
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder (att1, a') <- toShATerm' att0 $ InjMap.getAToB x
57a2436f9d44e37042498a3b3dfacd301d91bb6dChristian Maeder (att2, b') <- toShATerm' att1 $ InjMap.getBToA x
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder return $ addATerm (ShAAppl "InjMap" [a',b'] []) att2
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder fromShATermAux ix att0 = case getShATerm ix att0 of
d4892fa7401ceef014ea59d2d900773eaf88fcbdChristian Maeder ShAAppl "InjMap" [a,b] _ ->
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder case fromShATerm' a att0 of { (att1, a') ->
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder case fromShATerm' b att1 of { (att2, b') ->
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder (att2, InjMap.unsafeConstructInjMap a' b') }}
eee4b2ee739f163e09d6af6e45c025681e6c01a0Christian Maeder u -> fromShATermError "InjMap" u
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder_tc_RelTc :: TyCon
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder_tc_RelTc = mkTyCon "Common.Lib.Rel.Rel"
55adfe57a4de1f36adc3e3bfc16f342e44a7d444Christian Maederinstance Typeable1 Rel.Rel where
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder typeOf1 _ = mkTyConApp _tc_RelTc []
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederinstance (Ord a, ShATermConvertible a) => ShATermConvertible (Rel.Rel a) where
e593b89bfd4952698dc37feced21cefe869d87a2Christian Maeder toShATermAux att0 r = do
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder (att1, a') <- toShATerm' att0 $ Rel.toMap r
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder return $ addATerm (ShAAppl "Rel" [a'] []) att1
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder fromShATermAux ix att0 = case getShATerm ix att0 of
2e2094a642e3775b0d76b890556407941d3a53b6Christian Maeder ShAAppl "Rel" [a] _ ->
f13d1e86e58da53680e78043e8df182eed867efbChristian Maeder case fromShATerm' a att0 of { (att1, a') ->
96646aed2ae087b942ae23f15bbe729a8f7c43d3Christian Maeder u -> fromShATermError "Rel" u
c55a0f77be7e88d3620b419ec8961f4379a586e3Klaus Luettichinstance Typeable ClockTime where
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder typeOf _ = mkTyConApp ctTc []
abf2487c3aece95c371ea89ac64319370dcb6483Klaus Luettichinstance ShATermConvertible ClockTime where
8cacad2a09782249243b80985f28e9387019fe40Christian Maeder toShATermAux att0 (TOD a b) = do
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder (att1, a') <- toShATerm' att0 a
431d34c7007a787331c4e5ec997badb0f8190fc7Christian Maeder (att2, b') <- toShATerm' att1 b
431d34c7007a787331c4e5ec997badb0f8190fc7Christian Maeder return $ addATerm (ShAAppl "TOD" [a',b'] []) att2
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder fromShATermAux ix att0 = case getShATerm ix att0 of
d3ae0072823e2ef0d41d4431fcc768e66489c20eChristian Maeder ShAAppl "TOD" [a,b] _ ->
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder case fromShATerm' a att0 of { (att1, a') ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder case fromShATerm' b att1 of { (att2, b') ->
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (att2, TOD a' b') }}
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder u -> fromShATermError "ClockTime" u
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder#ifndef TIME_WITH_TYPEABLE
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian MaedertimeOfDayTc :: TyCon
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian MaedertimeOfDayTc = mkTyCon "Data.Time.TimeOfDay"
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederinstance Typeable TimeOfDay where
431d34c7007a787331c4e5ec997badb0f8190fc7Christian Maeder typeOf _ = mkTyConApp timeOfDayTc []
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maederinstance ShATermConvertible TimeOfDay where
c9acb8681bcc512245b4f0d1a9f2b189c60e10d4Christian Maeder toShATermAux att0 (TimeOfDay a b c) = do
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder (att1, a') <- toShATerm' att0 a
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder (att2, b') <- toShATerm' att1 b
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder (att3, c') <- toShATerm' att2 (toRational c :: Rational)
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder return $ addATerm (ShAAppl "TimeOfDay" [a',b',c'] []) att3
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder fromShATermAux ix att0 = case getShATerm ix att0 of
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder ShAAppl "TimeOfDay" [a,b,c] _ ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder case fromShATerm' a att0 of { (att1, a') ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder case fromShATerm' b att1 of { (att2, b') ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder case fromShATerm' c att2 of { (att3, c') ->
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder (att3, TimeOfDay a' b'
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder $ (fromRational :: Ratio Integer -> Pico) c') }}}
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder u -> fromShATermError "TimeOfDay" u