ToXml.hs revision d0916b96ca9f90822c0bb6062b13d5de83bf410a
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederModule : $Header$
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian MaederDescription : xml output of Hets specification libaries
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederCopyright : (c) Ewaryst Schulz, Uni Bremen 2009
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian MaederLicense : GPLv2 or higher, see LICENSE.txt
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian MaederMaintainer : Ewaryst.Schulz@dfki.de
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederStability : provisional
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederPortability : non-portable(Grothendieck)
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederXml printing of Hets specification libaries
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maedermodule Syntax.ToXml (xmlLibDefn) where
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maederimport Common.IRI (iriToStringUnsecure)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederxmlLibDefn :: LogicGraph -> GlobalAnnos -> LIB_DEFN -> Element
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederxmlLibDefn lg ga (Lib_defn n il rg an) =
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder add_attrs (mkNameAttr (show $ getLibId n) : rgAttrs rg)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder $ unode "Lib" $ annos "Global" ga an ++ libItems lg ga il
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederlibItems :: LogicGraph -> GlobalAnnos -> [Annoted LIB_ITEM] -> [Element]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederlibItems lg ga is = case is of
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder i : rs -> annoted libItem lg ga i : libItems (case item i of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Logic_decl aa _ -> setLogicName aa lg
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder _ -> lg) ga rs
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederunsupported :: PrettyLG a => LogicGraph -> GlobalAnnos -> a -> Element
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederunsupported lg ga =
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder unode "Unsupported" . show . useGlobalAnnos ga . prettyLG lg
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederlibItem :: LogicGraph -> GlobalAnnos -> LIB_ITEM -> Element
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederlibItem lg ga li = case li of
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder Spec_defn n g as rg ->
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder add_attrs (mkNameAttr (iriToStringUnsecure n) : rgAttrs rg)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder $ unode "SpecDefn" $ genericity lg ga g ++ [annoted spec lg ga as]
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder View_defn n g (View_type from to _) mapping rg ->
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder add_attrs (mkNameAttr (iriToStringUnsecure n) : rgAttrs rg)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder $ unode "ViewDefn" $ genericity lg ga g
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder ++ [ unode "Source" $ annoted spec lg ga from
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder , unode "Target" $ annoted spec lg ga to ]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder ++ concatMap (gmapping ga) mapping
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder Download_items n mapping rg ->
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder add_attrs (mkNameAttr (show $ getLibId n) : rgAttrs rg)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder $ unode "Import" $ downloadItems mapping
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Logic_decl n rg ->
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder add_attrs (mkNameAttr (showDoc n "") : rgAttrs rg)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder $ unode "Logic" ()
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder _ -> unsupported lg ga li
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederdownloadItems :: DownloadItems -> [Element]
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaederdownloadItems d = case d of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder ItemMaps l -> map itemNameOrMap l
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder UniqueItem i -> [add_attr (mkAttr "as" $ iriToStringUnsecure i)
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder $ unode "Item" ()]
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maederspec :: LogicGraph -> GlobalAnnos -> SPEC -> Element
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederspec lg ga s = case s of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Basic_spec bs rg -> withRg rg $ gBasicSpec lg ga bs
986e0e9cf8c2358f455460b3fc75ce7c5dcf0973Christian Maeder EmptySpec rg -> withRg rg $ unode "Empty" ()
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder Translation as (Renaming m _) ->
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder unode "Translation" $ annoted spec lg ga as : concatMap (gmapping ga) m
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder Reduction as m ->
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder unode "Restriction" $ annoted spec lg ga as : restriction ga m
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder Union asl rg -> withRg rg $ unode "Union"
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder $ map (unode "Spec" . annoted spec lg ga) asl
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder Extension asl rg -> withRg rg $ unode "Extension"
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder $ map (unode "Spec" . annoted spec lg ga) asl
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maeder Free_spec as rg -> withRg rg $ unode "Free" $ annoted spec lg ga as
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder Cofree_spec as rg -> withRg rg $ unode "Cofree" $ annoted spec lg ga as
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder Local_spec as ins rg -> withRg rg $ unode "Local"
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder [ unode "Spec" $ annoted spec lg ga as
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder , unode "Within" $ annoted spec lg ga ins]
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder Closed_spec as rg -> withRg rg $ unode "Closed" $ annoted spec lg ga as
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Group as rg -> withRg rg $ unode "Group" $ annoted spec lg ga as
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder Spec_inst n fa rg ->
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder add_attrs (mkNameAttr (iriToStringUnsecure n) : rgAttrs rg)
89054b2b95a3f92e78324dc852f3d34704e2ca49Christian Maeder $ unode "Actuals" $ map (annoted fitArg lg ga) fa
89054b2b95a3f92e78324dc852f3d34704e2ca49Christian Maeder Qualified_spec ln as rg -> withRg rg $ unode "Qualified"
89054b2b95a3f92e78324dc852f3d34704e2ca49Christian Maeder [prettyElem "Logic" ga ln, annoted spec (setLogicName ln lg) ga as]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Data l1 _ s1 s2 rg ->
b9eb4099ac3fd619c73f48cd022fc0f3c9b732f0Christian Maeder add_attrs (mkAttr "data-logic" (show l1) : rgAttrs rg)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder $ unode "Data" [ annoted spec (setCurLogic (show l1) lg) ga s1
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder , annoted spec lg ga s2]
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder Combination {} -> unsupported lg ga s
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederfitArg :: LogicGraph -> GlobalAnnos -> FIT_ARG -> Element
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaederfitArg lg ga fa = case fa of
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder Fit_spec as m rg -> withRg rg $ unode "Spec"
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder $ annoted spec lg ga as : concatMap (gmapping ga) m
af621d0066770895fd79562728e93099c8c52060Christian Maeder Fit_view n fargs rg ->
af621d0066770895fd79562728e93099c8c52060Christian Maeder add_attrs (mkNameAttr (iriToStringUnsecure n) : rgAttrs rg)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder $ unode "Spec" $ unode "Actuals" $ map (annoted fitArg lg ga) fargs
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederitemNameOrMap :: ItemNameMap -> Element
89054b2b95a3f92e78324dc852f3d34704e2ca49Christian MaederitemNameOrMap (ItemNameMap name m) =
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maeder add_attrs (mkNameAttr (iriToStringUnsecure name) : case m of
f353be6210f67ffd4a46967bba749afc968cee52Christian Maeder Nothing -> []
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Just as -> [mkAttr "as" $ iriToStringUnsecure as])
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder $ unode "Item" ()
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maedergmapping :: GlobalAnnos -> G_mapping -> [Element]
05e2a3161e4589a717c6fe5c7306820273a473c5Christian Maedergmapping ga gm = case gm of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder G_symb_map l -> subnodes "Mapping" $ gSymbMapItemList ga l
8485da94b57d8b5135ee685b55c982b037ed4140Christian Maeder G_logic_translation lc -> [ add_attrs (logicCode lc)
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder $ unode "Logictranslation" () ]
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maederghiding :: GlobalAnnos -> G_hiding -> Element
8485da94b57d8b5135ee685b55c982b037ed4140Christian Maederghiding ga gm = case gm of
8485da94b57d8b5135ee685b55c982b037ed4140Christian Maeder G_symb_list l -> unode "Hiding" $ gSymbItemList ga l
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder G_logic_projection lc -> add_attrs (logicCode lc)
8485da94b57d8b5135ee685b55c982b037ed4140Christian Maeder $ unode "Logicprojection" ()
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedergBasicSpec :: LogicGraph -> GlobalAnnos -> G_basic_spec -> Element
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedergBasicSpec lg ga (G_basic_spec lid bs) = itemToXml lg ga $ toItem lid bs
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maedergenericity :: LogicGraph -> GlobalAnnos -> GENERICITY -> [Element]
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maedergenericity lg ga (Genericity (Params pl) (Imported il) rg) =
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder if null pl then [] else
a94b530fa82bb281caac766a9c0f7b2fcfe7a584Christian Maeder unode "Parameters" (spec lg ga $ Union pl rg)
997c56f3bc74a703043010978e5013fdb074d659Christian Maeder : if null il then [] else
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder [ unode "Imports" $ spec lg ga $ Union il rg ]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederrestriction :: GlobalAnnos -> RESTRICTION -> [Element]
8485da94b57d8b5135ee685b55c982b037ed4140Christian Maederrestriction ga restr = case restr of
8485da94b57d8b5135ee685b55c982b037ed4140Christian Maeder Hidden m _ -> map (ghiding ga) m
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Revealed m _ -> gSymbMapItemList ga m
e76e6a43f51438215737d6fc176c89da05bb86daChristian MaedergSymbItemList :: GlobalAnnos -> G_symb_items_list -> [Element]
e76e6a43f51438215737d6fc176c89da05bb86daChristian MaedergSymbItemList ga (G_symb_items_list _ l) = map (prettyElem "SymbItems" ga) l
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaedergSymbMapItemList :: GlobalAnnos -> G_symb_map_items_list -> [Element]
e76e6a43f51438215737d6fc176c89da05bb86daChristian MaedergSymbMapItemList ga (G_symb_map_items_list _ l) =
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maeder map (prettyElem "SymbMapItems" ga) l
8485da94b57d8b5135ee685b55c982b037ed4140Christian MaederlogicCode :: Logic_code -> [Attr]
dc6b48bb46df8e56da3491c98476e6da0d1d5d1dChristian MaederlogicCode (Logic_code enc src trg _) =
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder Nothing -> []
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder Just t -> [mkAttr "encoding" t])
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder ++ (case src of
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder Nothing -> []
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Just l -> [mkAttr "source" $ show $ pretty l])
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder ++ case trg of
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder Nothing -> []
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Just l -> [mkAttr "target" $ show $ pretty l]
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian MaederisEmptyItem :: Annoted Item -> Bool
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederisEmptyItem ai =
fcec1ffa4a95dbc47cf23f75e6843ceff93a925eChristian Maeder let i = item ai
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder IT _ attrs mdoc = itemType i
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder in null (rgAttrs $ range i) && null attrs && isNothing mdoc
836e72a3c413366ba9801726f3b249c7791cb9caChristian Maeder && null (l_annos ai) && null (r_annos ai)
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder && all isEmptyItem (items i)
c1031ac42b3f3d7d0fe7d9d6b54423a092d473a0Christian MaederitemToXml :: LogicGraph -> GlobalAnnos -> Item -> Element
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian MaederitemToXml lg ga i =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder let IT name attrs mdoc = itemType i
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder in add_attrs (map (uncurry mkAttr) attrs ++ rgAttrs (range i))
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder $ unode name $ (case mdoc of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Nothing -> []
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maeder Just d -> [mkText $ show $ useGlobalAnnos ga d])
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maeder ++ map (Elem . annoted itemToXml lg ga)
fe5dbb45b6a8abf34375b4bc5f2a81cda664c0e4Christian Maeder (filter (not . isEmptyItem) $ items i)
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder-- range attribute without file name
b5699d97a9e2b4496f98d624f4b0a537986651c3Christian MaederrgAttrs :: Range -> [Attr]
3cafc73a998493f9ed3d5e934c0ab80bcfb465c2Christian MaederrgAttrs = rangeAttrsF $ show . prettyRange . map (\ p -> p { sourceName = "" })
7bf6d421b0ea31ae63f1fe04919942b931abda47Christian Maederannos :: String -> GlobalAnnos -> [Annotation] -> [Element]
7bf6d421b0ea31ae63f1fe04919942b931abda47Christian Maederannos str ga = subnodes str
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder . map (annotationF rgAttrs ga)
7bf6d421b0ea31ae63f1fe04919942b931abda47Christian Maederannoted :: (LogicGraph -> GlobalAnnos -> a -> Element) -> LogicGraph
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder -> GlobalAnnos -> Annoted a -> Element
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maederannoted f lg ga a = let
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder e = f lg ga $ item a
7c554e9d4a39b8eb3b0881f20807c95dd8e793aeChristian Maeder l = annos "Left" ga $ l_annos a
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder r = annos "Right" ga $ r_annos a
7bf6d421b0ea31ae63f1fe04919942b931abda47Christian Maeder in e { elContent = map Elem l ++ elContent e ++ map Elem r }
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederwithRg :: Range -> Element -> Element
7bf6d421b0ea31ae63f1fe04919942b931abda47Christian MaederwithRg r e = if isJust (getAttrVal "range" e) then e else
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder add_attrs (rgAttrs r) e