{- |
Module      :  ./Common/ConvertGlobalAnnos.hs
Description :  convert global annotations to a list of annotations
Copyright   :  (c) Carsten Fischer and Uni Bremen 2003-2006
License     :  GPLv2 or higher, see LICENSE.txt

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

Convert global annotations to a list of annotations
-}

module Common.ConvertGlobalAnnos
  ( mergeGlobalAnnos
  , convertGlobalAnnos
  , convertLiteralAnnos
  , removeDOLprefixes
  ) where

import Common.Id
import Common.IRI
import Common.GlobalAnnotations
import Common.AS_Annotation
import qualified Common.Lib.Rel as Rel
import Common.AnalyseAnnos
import Common.Result
import Common.DocUtils

import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (partition, groupBy, sortBy)
import Data.Ord
import Data.Function (on)

instance Pretty GlobalAnnos where
  pretty :: GlobalAnnos -> Doc
pretty = [Annotation] -> Doc
printAnnotationList ([Annotation] -> Doc)
-> (GlobalAnnos -> [Annotation]) -> GlobalAnnos -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalAnnos -> [Annotation]
convertGlobalAnnos (GlobalAnnos -> [Annotation])
-> (GlobalAnnos -> GlobalAnnos) -> GlobalAnnos -> [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalAnnos -> GlobalAnnos
removeDOLprefixes

removeDOLprefixes :: GlobalAnnos -> GlobalAnnos
removeDOLprefixes :: GlobalAnnos -> GlobalAnnos
removeDOLprefixes ga :: GlobalAnnos
ga = GlobalAnnos
ga
  { prefix_map :: PrefixMap
prefix_map = (IRI -> Bool) -> PrefixMap -> PrefixMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (IRI -> Bool) -> IRI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool) -> (IRI -> [Char]) -> IRI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> [Char]
iriScheme) (PrefixMap -> PrefixMap) -> PrefixMap -> PrefixMap
forall a b. (a -> b) -> a -> b
$ GlobalAnnos -> PrefixMap
prefix_map GlobalAnnos
ga }

convertGlobalAnnos :: GlobalAnnos -> [Annotation]
convertGlobalAnnos :: GlobalAnnos -> [Annotation]
convertGlobalAnnos ga :: GlobalAnnos
ga = PrefixMap -> [Annotation]
convertPrefixMap (GlobalAnnos -> PrefixMap
prefix_map GlobalAnnos
ga)
              [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ PrecedenceGraph -> [Annotation]
convertPrec (GlobalAnnos -> PrecedenceGraph
prec_annos GlobalAnnos
ga)
              [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ AssocMap -> [Annotation]
convertAssoc (GlobalAnnos -> AssocMap
assoc_annos GlobalAnnos
ga)
              [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ DisplayMap -> [Annotation]
convertDispl (GlobalAnnos -> DisplayMap
display_annos GlobalAnnos
ga)
              [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ LiteralAnnos -> [Annotation]
convertLiteralAnnos (GlobalAnnos -> LiteralAnnos
literal_annos GlobalAnnos
ga)

mergeGlobalAnnos :: GlobalAnnos -> GlobalAnnos -> Result GlobalAnnos
mergeGlobalAnnos :: GlobalAnnos -> GlobalAnnos -> Result GlobalAnnos
mergeGlobalAnnos ga1 :: GlobalAnnos
ga1 = GlobalAnnos -> [Annotation] -> Result GlobalAnnos
addGlobalAnnos GlobalAnnos
ga1 ([Annotation] -> Result GlobalAnnos)
-> (GlobalAnnos -> [Annotation])
-> GlobalAnnos
-> Result GlobalAnnos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalAnnos -> [Annotation]
convertGlobalAnnos

convertPrec :: PrecedenceGraph -> [Annotation]
convertPrec :: PrecedenceGraph -> [Annotation]
convertPrec pg :: PrecedenceGraph
pg =
    let cs :: [Set Id]
cs = PrecedenceGraph -> [Set Id]
forall a. Ord a => Rel a -> [Set a]
Rel.sccOfClosure PrecedenceGraph
pg
    in ([Id] -> Annotation) -> [[Id]] -> [Annotation]
forall a b. (a -> b) -> [a] -> [b]
map (\ l :: [Id]
l -> let (f :: [Id]
f, r :: [Id]
r) = Int -> [Id] -> ([Id], [Id])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div ([Id] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Id]
l) 2) [Id]
l in
                   PrecRel -> [Id] -> [Id] -> Range -> Annotation
Prec_anno PrecRel
BothDirections [Id]
f [Id]
r Range
nullRange)
           (([Id] -> Bool) -> [[Id]] -> [[Id]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Int -> Bool) -> ([Id] -> Int) -> [Id] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Id]] -> [[Id]]) -> [[Id]] -> [[Id]]
forall a b. (a -> b) -> a -> b
$ (Set Id -> [Id]) -> [Set Id] -> [[Id]]
forall a b. (a -> b) -> [a] -> [b]
map Set Id -> [Id]
forall a. Set a -> [a]
Set.toList [Set Id]
cs)
       [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ ([(Id, Set Id)] -> Annotation) -> [[(Id, Set Id)]] -> [Annotation]
forall a b. (a -> b) -> [a] -> [b]
map (\ l :: [(Id, Set Id)]
l ->
        PrecRel -> [Id] -> [Id] -> Range -> Annotation
Prec_anno PrecRel
Lower (((Id, Set Id) -> Id) -> [(Id, Set Id)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, Set Id) -> Id
forall a b. (a, b) -> a
fst [(Id, Set Id)]
l) (Set Id -> [Id]
forall a. Set a -> [a]
Set.toList (Set Id -> [Id]) -> Set Id -> [Id]
forall a b. (a -> b) -> a -> b
$ (Id, Set Id) -> Set Id
forall a b. (a, b) -> b
snd ((Id, Set Id) -> Set Id) -> (Id, Set Id) -> Set Id
forall a b. (a -> b) -> a -> b
$ [(Id, Set Id)] -> (Id, Set Id)
forall a. [a] -> a
head [(Id, Set Id)]
l) Range
nullRange)
        (((Id, Set Id) -> (Id, Set Id) -> Bool)
-> [(Id, Set Id)] -> [[(Id, Set Id)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Set Id -> Set Id -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Set Id -> Set Id -> Bool)
-> ((Id, Set Id) -> Set Id) -> (Id, Set Id) -> (Id, Set Id) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Id, Set Id) -> Set Id
forall a b. (a, b) -> b
snd)
          ([(Id, Set Id)] -> [[(Id, Set Id)]])
-> [(Id, Set Id)] -> [[(Id, Set Id)]]
forall a b. (a -> b) -> a -> b
$ ((Id, Set Id) -> (Id, Set Id) -> Ordering)
-> [(Id, Set Id)] -> [(Id, Set Id)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Id, Set Id) -> Set Id)
-> (Id, Set Id) -> (Id, Set Id) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Id, Set Id) -> Set Id
forall a b. (a, b) -> b
snd)
            ([(Id, Set Id)] -> [(Id, Set Id)])
-> [(Id, Set Id)] -> [(Id, Set Id)]
forall a b. (a -> b) -> a -> b
$ Map Id (Set Id) -> [(Id, Set Id)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Id (Set Id) -> [(Id, Set Id)])
-> Map Id (Set Id) -> [(Id, Set Id)]
forall a b. (a -> b) -> a -> b
$ PrecedenceGraph -> Map Id (Set Id)
forall a. Rel a -> Map a (Set a)
Rel.toMap
               (PrecedenceGraph -> Map Id (Set Id))
-> PrecedenceGraph -> Map Id (Set Id)
forall a b. (a -> b) -> a -> b
$ PrecedenceGraph -> PrecedenceGraph
forall a. Ord a => Rel a -> Rel a
Rel.rmNullSets (PrecedenceGraph -> PrecedenceGraph)
-> PrecedenceGraph -> PrecedenceGraph
forall a b. (a -> b) -> a -> b
$ PrecedenceGraph -> PrecedenceGraph
forall a. Ord a => Rel a -> Rel a
Rel.transReduce (PrecedenceGraph -> PrecedenceGraph)
-> PrecedenceGraph -> PrecedenceGraph
forall a b. (a -> b) -> a -> b
$ PrecedenceGraph -> PrecedenceGraph
forall a. Ord a => Rel a -> Rel a
Rel.irreflex
               (PrecedenceGraph -> PrecedenceGraph)
-> PrecedenceGraph -> PrecedenceGraph
forall a b. (a -> b) -> a -> b
$ [Set Id] -> PrecedenceGraph -> PrecedenceGraph
forall a. Ord a => [Set a] -> Rel a -> Rel a
Rel.collaps [Set Id]
cs PrecedenceGraph
pg)

convertAssoc :: AssocMap -> [Annotation]
convertAssoc :: AssocMap -> [Annotation]
convertAssoc am :: AssocMap
am =
    let (i1s :: [(Id, AssocEither)]
i1s, i2s :: [(Id, AssocEither)]
i2s) = ((Id, AssocEither) -> Bool)
-> [(Id, AssocEither)]
-> ([(Id, AssocEither)], [(Id, AssocEither)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((AssocEither -> AssocEither -> Bool
forall a. Eq a => a -> a -> Bool
== AssocEither
ALeft) (AssocEither -> Bool)
-> ((Id, AssocEither) -> AssocEither) -> (Id, AssocEither) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id, AssocEither) -> AssocEither
forall a b. (a, b) -> b
snd) ([(Id, AssocEither)] -> ([(Id, AssocEither)], [(Id, AssocEither)]))
-> [(Id, AssocEither)]
-> ([(Id, AssocEither)], [(Id, AssocEither)])
forall a b. (a -> b) -> a -> b
$ AssocMap -> [(Id, AssocEither)]
forall k a. Map k a -> [(k, a)]
Map.toList AssocMap
am
        -- [(Id,assEith)]
    in [AssocEither -> [Id] -> Range -> Annotation
Assoc_anno AssocEither
ALeft (((Id, AssocEither) -> Id) -> [(Id, AssocEither)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, AssocEither) -> Id
forall a b. (a, b) -> a
fst [(Id, AssocEither)]
i1s) Range
nullRange | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Id, AssocEither)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Id, AssocEither)]
i1s]
       [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [AssocEither -> [Id] -> Range -> Annotation
Assoc_anno AssocEither
ARight (((Id, AssocEither) -> Id) -> [(Id, AssocEither)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, AssocEither) -> Id
forall a b. (a, b) -> a
fst [(Id, AssocEither)]
i2s) Range
nullRange | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Id, AssocEither)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Id, AssocEither)]
i2s ]

convertDispl :: DisplayMap -> [Annotation]
convertDispl :: DisplayMap -> [Annotation]
convertDispl dm :: DisplayMap
dm =
    let m1 :: [(Id, Map Display_format [Token])]
m1 = DisplayMap -> [(Id, Map Display_format [Token])]
forall k a. Map k a -> [(k, a)]
Map.toList DisplayMap
dm -- m1::[(Id,Map.Map Display_format [Token])]
        toStrTup :: (a, t Token) -> (a, [Char])
toStrTup (x :: a
x, y :: t Token
y) = (a
x, (Token -> [Char]) -> t Token -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [Char]
tokStr t Token
y)
        m2 :: [(Id, [(Display_format, [Char])])]
m2 = ((Id, Map Display_format [Token])
 -> (Id, [(Display_format, [Char])]))
-> [(Id, Map Display_format [Token])]
-> [(Id, [(Display_format, [Char])])]
forall a b. (a -> b) -> [a] -> [b]
map (\ (x :: Id
x, m :: Map Display_format [Token]
m) -> (Id
x, ((Display_format, [Token]) -> (Display_format, [Char]))
-> [(Display_format, [Token])] -> [(Display_format, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (Display_format, [Token]) -> (Display_format, [Char])
forall (t :: * -> *) a. Foldable t => (a, t Token) -> (a, [Char])
toStrTup ([(Display_format, [Token])] -> [(Display_format, [Char])])
-> [(Display_format, [Token])] -> [(Display_format, [Char])]
forall a b. (a -> b) -> a -> b
$ Map Display_format [Token] -> [(Display_format, [Token])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Display_format [Token]
m)) [(Id, Map Display_format [Token])]
m1
        -- m2::[(ID,[(Display_format,String)])]
    in ((Id, [(Display_format, [Char])]) -> Annotation)
-> [(Id, [(Display_format, [Char])])] -> [Annotation]
forall a b. (a -> b) -> [a] -> [b]
map (\ (i :: Id
i, x :: [(Display_format, [Char])]
x) -> Id -> [(Display_format, [Char])] -> Range -> Annotation
Display_anno Id
i [(Display_format, [Char])]
x Range
nullRange) [(Id, [(Display_format, [Char])])]
m2

convertLiteralAnnos :: LiteralAnnos -> [Annotation]
convertLiteralAnnos :: LiteralAnnos -> [Annotation]
convertLiteralAnnos la :: LiteralAnnos
la = let
  str :: [Annotation]
str = case LiteralAnnos -> Maybe (Id, Id)
string_lit LiteralAnnos
la of
          Just (x :: Id
x, y :: Id
y) -> [Id -> Id -> Range -> Annotation
String_anno Id
x Id
y Range
nullRange]
          _ -> []
  lis :: [Annotation]
lis = ((Id, (Id, Id)) -> Annotation) -> [(Id, (Id, Id))] -> [Annotation]
forall a b. (a -> b) -> [a] -> [b]
map (\ (br :: Id
br, (n :: Id
n, con :: Id
con)) -> Id -> Id -> Id -> Range -> Annotation
List_anno Id
br Id
n Id
con Range
nullRange)
          ([(Id, (Id, Id))] -> [Annotation])
-> [(Id, (Id, Id))] -> [Annotation]
forall a b. (a -> b) -> a -> b
$ Map Id (Id, Id) -> [(Id, (Id, Id))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Id (Id, Id) -> [(Id, (Id, Id))])
-> Map Id (Id, Id) -> [(Id, (Id, Id))]
forall a b. (a -> b) -> a -> b
$ LiteralAnnos -> Map Id (Id, Id)
list_lit LiteralAnnos
la
  number :: [Annotation]
number = case LiteralAnnos -> Maybe Id
number_lit LiteralAnnos
la of
             Just x :: Id
x -> [Id -> Range -> Annotation
Number_anno Id
x Range
nullRange]
             _ -> []
  flo :: [Annotation]
flo = case LiteralAnnos -> Maybe (Id, Id)
float_lit LiteralAnnos
la of
          Just (a :: Id
a, b :: Id
b) -> [Id -> Id -> Range -> Annotation
Float_anno Id
a Id
b Range
nullRange]
          _ -> []
  in [Annotation]
str [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
lis [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
number [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
flo

convertPrefixMap :: PrefixMap -> [Annotation]
convertPrefixMap :: PrefixMap -> [Annotation]
convertPrefixMap pm :: PrefixMap
pm =
  if PrefixMap -> Bool
forall k a. Map k a -> Bool
Map.null PrefixMap
pm then [] else [[([Char], IRI)] -> Range -> Annotation
Prefix_anno (PrefixMap -> [([Char], IRI)]
forall k a. Map k a -> [(k, a)]
Map.toList PrefixMap
pm) Range
nullRange]