{- |
Module      :  ./CASL/CompositionTable/Pretty2.hs
Description :  pretty output for composition tables
Copyright   :  (c) Christian Maeder DFKI 2012
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

-}

module CASL.CompositionTable.Pretty2 where

import CASL.CompositionTable.CompositionTable
import CASL.CompositionTable.ModelTable
import CASL.CompositionTable.Keywords

import qualified Data.IntSet as IntSet
import qualified Data.IntMap as IntMap

import Common.Doc

ctxt :: String -> Doc
ctxt :: String -> Doc
ctxt = String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (':' Char -> String -> String
forall a. a -> [a] -> [a]
:)

table2Doc :: Table2 -> Doc
table2Doc :: Table2 -> Doc
table2Doc (Table2 name :: String
name br :: Int
br m :: IntMap Baserel
m brs :: BSet
brs cs :: CmpTbl
cs ct :: ConTables
ct) =
   Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
defCalculusS Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
name)
   Doc -> Doc -> Doc
$+$ String -> Doc
ctxt String
identityRelationS Doc -> Doc -> Doc
<+> IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m Int
br
   Doc -> Doc -> Doc
$+$ (if BSet -> Bool
IntSet.null BSet
brs then Doc
empty else
        String -> Doc
ctxt String
baseRelationsS Doc -> Doc -> Doc
<+> Doc -> Doc
parens
             ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m) ([Int] -> [Doc]) -> [Int] -> [Doc]
forall a b. (a -> b) -> a -> b
$ BSet -> [Int]
IntSet.toList BSet
brs))
   Doc -> Doc -> Doc
$+$ IntMap Baserel -> ConTables -> Doc
conversetable IntMap Baserel
m ConTables
ct
   Doc -> Doc -> Doc
$+$ (if CmpTbl -> Bool
forall a. IntMap a -> Bool
IntMap.null CmpTbl
cs then Doc
empty else
        Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (String -> Doc
text String
compositionOperationS Doc -> Doc -> Doc
$+$
                  Doc -> Doc
parens ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Int, IntMap BSet) -> [Doc]) -> [(Int, IntMap BSet)] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IntMap Baserel -> (Int, IntMap BSet) -> [Doc]
cmptab IntMap Baserel
m) ([(Int, IntMap BSet)] -> [Doc]) -> [(Int, IntMap BSet)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ CmpTbl -> [(Int, IntMap BSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList CmpTbl
cs)))

baserel :: IntMap.IntMap Baserel -> Int -> Doc
baserel :: IntMap Baserel -> Int -> Doc
baserel m :: IntMap Baserel
m i :: Int
i = case Int -> IntMap Baserel -> Maybe Baserel
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap Baserel
m of
  Just (Baserel br :: String
br) -> String -> Doc
text String
br
  Nothing -> String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "CASL.CompositionTable.Pretty2.baserel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

cmptab :: IntMap.IntMap Baserel -> (Int, IntMap.IntMap IntSet.IntSet) -> [Doc]
cmptab :: IntMap Baserel -> (Int, IntMap BSet) -> [Doc]
cmptab m :: IntMap Baserel
m (a1 :: Int
a1, m2 :: IntMap BSet
m2) = ((Int, BSet) -> Doc) -> [(Int, BSet)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  (\ (a2 :: Int
a2, s :: BSet
s) -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m Int
a1 Doc -> Doc -> Doc
<+> IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m Int
a2
                Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m) ([Int] -> [Doc]) -> [Int] -> [Doc]
forall a b. (a -> b) -> a -> b
$ BSet -> [Int]
IntSet.toList BSet
s))
  ([(Int, BSet)] -> [Doc]) -> [(Int, BSet)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ IntMap BSet -> [(Int, BSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap BSet
m2

conversetable :: IntMap.IntMap Baserel -> ConTables -> Doc
conversetable :: IntMap Baserel -> ConTables -> Doc
conversetable m :: IntMap Baserel
m (l :: IntMap BSet
l, l1 :: IntMap BSet
l1, l2 :: IntMap BSet
l2, l3 :: IntMap BSet
l3) =
    [Doc] -> Doc
vcat [ IntMap Baserel -> String -> IntMap BSet -> Doc
contab IntMap Baserel
m String
converseOperationS IntMap BSet
l
         , IntMap Baserel -> String -> IntMap BSet -> Doc
contab IntMap Baserel
m String
inverseOperationS IntMap BSet
l1
         , IntMap Baserel -> String -> IntMap BSet -> Doc
contab IntMap Baserel
m String
shortcutOperationS IntMap BSet
l2
         , IntMap Baserel -> String -> IntMap BSet -> Doc
contab IntMap Baserel
m String
homingOperationS IntMap BSet
l3 ]

contab :: IntMap.IntMap Baserel -> String -> ConTable -> Doc
contab :: IntMap Baserel -> String -> IntMap BSet -> Doc
contab m :: IntMap Baserel
m t :: String
t l :: IntMap BSet
l = if IntMap BSet -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap BSet
l then Doc
empty else
   Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (String -> Doc
text String
t Doc -> Doc -> Doc
$+$ Doc -> Doc
parens ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Int, BSet) -> Doc) -> [(Int, BSet)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (IntMap Baserel -> (Int, BSet) -> Doc
contabentry IntMap Baserel
m) ([(Int, BSet)] -> [Doc]) -> [(Int, BSet)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ IntMap BSet -> [(Int, BSet)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap BSet
l))

contabentry :: IntMap.IntMap Baserel -> (Int, IntSet.IntSet) -> Doc
contabentry :: IntMap Baserel -> (Int, BSet) -> Doc
contabentry m :: IntMap Baserel
m (a :: Int
a, bs :: BSet
bs) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m Int
a Doc -> Doc -> Doc
<+> case BSet -> [Int]
IntSet.toList BSet
bs of
  [b :: Int
b] -> IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m Int
b
  l :: [Int]
l -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (IntMap Baserel -> Int -> Doc
baserel IntMap Baserel
m) [Int]
l