{- |
Module      :  ./Syntax/Print_AS_Structured.hs
Description :  pretty printing of CASL structured specifications
Copyright   :  (c) Klaus Luettich, Uni Bremen 2002-2006
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable(Grothendieck)

Pretty printing of CASL structured specifications
-}

module Syntax.Print_AS_Structured
    ( structIRI
    , printGroupSpec
    , skipVoidGroup
    , printUnion
    , printExtension
    , moveAnnos
    , PrettyLG (..)
    ) where

import Common.Id
import Common.IRI
import Common.Keywords
import Common.Doc
import Common.DocUtils
import Common.AS_Annotation

import Logic.Grothendieck
import Logic.Logic

import Syntax.AS_Structured

sublogicId :: SIMPLE_ID -> Doc
sublogicId :: SIMPLE_ID -> Doc
sublogicId = String -> Doc
structId (String -> Doc) -> (SIMPLE_ID -> String) -> SIMPLE_ID -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SIMPLE_ID -> String
tokStr

structIRI :: IRI -> Doc
structIRI :: IRI -> Doc
structIRI = String -> Doc
structId (String -> Doc) -> (IRI -> String) -> IRI -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> String
iriToStringShortUnsecure -- also print user information

class PrettyLG a where
  prettyLG :: LogicGraph -> a -> Doc

instance PrettyLG a => PrettyLG (Annoted a) where
    prettyLG :: LogicGraph -> Annoted a -> Doc
prettyLG lg :: LogicGraph
lg = (a -> Doc) -> Annoted a -> Doc
forall a. (a -> Doc) -> Annoted a -> Doc
printAnnoted ((a -> Doc) -> Annoted a -> Doc) -> (a -> Doc) -> Annoted a -> Doc
forall a b. (a -> b) -> a -> b
$ LogicGraph -> a -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg

instance PrettyLG SPEC where
    prettyLG :: LogicGraph -> SPEC -> Doc
prettyLG = LogicGraph -> SPEC -> Doc
printSPEC

printUnion :: LogicGraph -> [Annoted SPEC] -> [Doc]
printUnion :: LogicGraph -> [Annoted SPEC] -> [Doc]
printUnion lg :: LogicGraph
lg = Doc -> [Doc] -> [Doc]
prepPunctuate (String -> Doc
topKey String
andS Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) ([Doc] -> [Doc])
-> ([Annoted SPEC] -> [Doc]) -> [Annoted SPEC] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annoted SPEC -> Doc) -> [Annoted SPEC] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (LogicGraph -> Annoted SPEC -> Doc
condBracesAnd LogicGraph
lg)

printIntersection :: LogicGraph -> [Annoted SPEC] -> [Doc]
printIntersection :: LogicGraph -> [Annoted SPEC] -> [Doc]
printIntersection lg :: LogicGraph
lg = Doc -> [Doc] -> [Doc]
prepPunctuate (String -> Doc
topKey String
intersectS Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) ([Doc] -> [Doc])
-> ([Annoted SPEC] -> [Doc]) -> [Annoted SPEC] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annoted SPEC -> Doc) -> [Annoted SPEC] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (LogicGraph -> Annoted SPEC -> Doc
condBracesAnd LogicGraph
lg)

moveAnnos :: Annoted SPEC -> [Annoted SPEC] -> [Annoted SPEC]
moveAnnos :: Annoted SPEC -> [Annoted SPEC] -> [Annoted SPEC]
moveAnnos x :: Annoted SPEC
x l :: [Annoted SPEC]
l = [Annoted SPEC] -> [Annoted SPEC]
forall a. [Annoted a] -> [Annoted a]
appAnno ([Annoted SPEC] -> [Annoted SPEC])
-> [Annoted SPEC] -> [Annoted SPEC]
forall a b. (a -> b) -> a -> b
$ case [Annoted SPEC]
l of
    [] -> String -> [Annoted SPEC]
forall a. HasCallStack => String -> a
error "moveAnnos"
    h :: Annoted SPEC
h : r :: [Annoted SPEC]
r -> Annoted SPEC
h { l_annos :: [Annotation]
l_annos = Annoted SPEC -> [Annotation]
forall a. Annoted a -> [Annotation]
l_annos Annoted SPEC
x [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ Annoted SPEC -> [Annotation]
forall a. Annoted a -> [Annotation]
l_annos Annoted SPEC
h } Annoted SPEC -> [Annoted SPEC] -> [Annoted SPEC]
forall a. a -> [a] -> [a]
: [Annoted SPEC]
r
    where appAnno :: [Annoted a] -> [Annoted a]
appAnno a :: [Annoted a]
a = case [Annoted a]
a of
                 [] -> []
                 [h :: Annoted a
h] -> [Annoted a -> [Annotation] -> Annoted a
forall a. Annoted a -> [Annotation] -> Annoted a
appendAnno Annoted a
h (Annoted SPEC -> [Annotation]
forall a. Annoted a -> [Annotation]
r_annos Annoted SPEC
x)]
                 h :: Annoted a
h : r :: [Annoted a]
r -> Annoted a
h Annoted a -> [Annoted a] -> [Annoted a]
forall a. a -> [a] -> [a]
: [Annoted a] -> [Annoted a]
appAnno [Annoted a]
r

printOptUnion :: LogicGraph -> Annoted SPEC -> [Doc]
printOptUnion :: LogicGraph -> Annoted SPEC -> [Doc]
printOptUnion lg :: LogicGraph
lg x :: Annoted SPEC
x = case SPEC -> SPEC
skipVoidGroup (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
x of
        Union e :: [Annoted SPEC]
e@(_ : _) _ -> LogicGraph -> [Annoted SPEC] -> [Doc]
printUnion LogicGraph
lg ([Annoted SPEC] -> [Doc]) -> [Annoted SPEC] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> [Annoted SPEC] -> [Annoted SPEC]
moveAnnos Annoted SPEC
x [Annoted SPEC]
e
        Extension e :: [Annoted SPEC]
e@(_ : _) _ -> LogicGraph -> [Annoted SPEC] -> [Doc]
printExtension LogicGraph
lg ([Annoted SPEC] -> [Doc]) -> [Annoted SPEC] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> [Annoted SPEC] -> [Annoted SPEC]
moveAnnos Annoted SPEC
x [Annoted SPEC]
e
        _ -> [LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
x]

printExtension :: LogicGraph -> [Annoted SPEC] -> [Doc]
printExtension :: LogicGraph -> [Annoted SPEC] -> [Doc]
printExtension lg :: LogicGraph
lg l :: [Annoted SPEC]
l = case [Annoted SPEC]
l of
    [] -> []
    x :: Annoted SPEC
x : r :: [Annoted SPEC]
r -> LogicGraph -> Annoted SPEC -> [Doc]
printOptUnion LogicGraph
lg Annoted SPEC
x [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
             (Annoted SPEC -> [Doc]) -> [Annoted SPEC] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\ u :: [Doc]
u -> case [Doc]
u of
                            [] -> []
                            d :: Doc
d : s :: [Doc]
s -> (String -> Doc
topKey String
thenS Doc -> Doc -> Doc
<+> Doc
d) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
s) ([Doc] -> [Doc])
-> (Annoted SPEC -> [Doc]) -> Annoted SPEC -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        LogicGraph -> Annoted SPEC -> [Doc]
printOptUnion LogicGraph
lg) [Annoted SPEC]
r

printSPEC :: LogicGraph -> SPEC -> Doc
printSPEC :: LogicGraph -> SPEC -> Doc
printSPEC lg :: LogicGraph
lg spec :: SPEC
spec = case SPEC
spec of
    Basic_spec (G_basic_spec lid :: lid
lid basic_spec :: basic_spec
basic_spec) _ ->
        case String -> LogicGraph -> Maybe (AnyLogic, Maybe IRI)
forall (m :: * -> *).
MonadFail m =>
String -> LogicGraph -> m (AnyLogic, Maybe IRI)
lookupCurrentSyntax "" LogicGraph
lg of
      Just (Logic lid2 :: lid
lid2, sm :: Maybe IRI
sm) -> if lid -> String
forall lid. Language lid => lid -> String
language_name lid
lid2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= lid -> String
forall lid. Language lid => lid -> String
language_name lid
lid
          then String -> Doc
forall a. HasCallStack => String -> a
error "printSPEC: logic mismatch"
          else case Maybe IRI -> lid -> Maybe (basic_spec -> Doc)
forall lid basic_spec symbol symb_items symb_map_items.
Syntax lid basic_spec symbol symb_items symb_map_items =>
Maybe IRI -> lid -> Maybe (basic_spec -> Doc)
basicSpecPrinter Maybe IRI
sm lid
lid of
        Just p :: basic_spec -> Doc
p -> basic_spec -> Doc
p basic_spec
basic_spec
        _ -> String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "printSPEC: no basic spec printer for "
             String -> String -> String
forall a. [a] -> [a] -> [a]
++ lid -> Maybe IRI -> String
forall lid. Language lid => lid -> Maybe IRI -> String
showSyntax lid
lid Maybe IRI
sm
      _ -> String -> Doc
forall a. HasCallStack => String -> a
error "printSPEC: incomplete logic graph"
    EmptySpec _ -> Doc -> Doc
specBraces Doc
empty
    Extraction aa :: Annoted SPEC
aa ab :: EXTRACTION
ab -> [Doc] -> Doc
sep [LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct LogicGraph
lg Annoted SPEC
aa, EXTRACTION -> Doc
printEXTRACTION EXTRACTION
ab]
    Translation aa :: Annoted SPEC
aa ab :: RENAMING
ab -> [Doc] -> Doc
sep [LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct LogicGraph
lg Annoted SPEC
aa, RENAMING -> Doc
printRENAMING RENAMING
ab]
    Reduction aa :: Annoted SPEC
aa ab :: RESTRICTION
ab -> [Doc] -> Doc
sep [LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct LogicGraph
lg Annoted SPEC
aa, RESTRICTION -> Doc
printRESTRICTION RESTRICTION
ab]
    Approximation aa :: Annoted SPEC
aa ab :: APPROXIMATION
ab ->
      [Doc] -> Doc
sep [LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct LogicGraph
lg Annoted SPEC
aa, APPROXIMATION -> Doc
printAPPROXIMATION APPROXIMATION
ab]
    Minimization aa :: Annoted SPEC
aa ab :: MINIMIZATION
ab ->
      [Doc] -> Doc
sep [LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct LogicGraph
lg Annoted SPEC
aa, MINIMIZATION -> Doc
printMINIMIZATION MINIMIZATION
ab]
    Filtering aa :: Annoted SPEC
aa ab :: FILTERING
ab -> [Doc] -> Doc
sep [LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct LogicGraph
lg Annoted SPEC
aa, FILTERING -> Doc
printFILTERING FILTERING
ab]
    Union aa :: [Annoted SPEC]
aa _ -> [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ LogicGraph -> [Annoted SPEC] -> [Doc]
printUnion LogicGraph
lg [Annoted SPEC]
aa
    Intersection aa :: [Annoted SPEC]
aa _ -> [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ LogicGraph -> [Annoted SPEC] -> [Doc]
printIntersection LogicGraph
lg [Annoted SPEC]
aa
    Extension aa :: [Annoted SPEC]
aa _ -> [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ LogicGraph -> [Annoted SPEC] -> [Doc]
printExtension LogicGraph
lg [Annoted SPEC]
aa
    Free_spec aa :: Annoted SPEC
aa _ -> [Doc] -> Doc
sep [String -> Doc
keyword String
freeS, LogicGraph -> Annoted SPEC -> Doc
printGroupSpec LogicGraph
lg Annoted SPEC
aa]
    Cofree_spec aa :: Annoted SPEC
aa _ -> [Doc] -> Doc
sep [String -> Doc
keyword String
cofreeS, LogicGraph -> Annoted SPEC -> Doc
printGroupSpec LogicGraph
lg Annoted SPEC
aa]
    Minimize_spec aa :: Annoted SPEC
aa _ -> [Doc] -> Doc
sep [String -> Doc
keyword String
minimizeS, LogicGraph -> Annoted SPEC -> Doc
printGroupSpec LogicGraph
lg Annoted SPEC
aa]
    Local_spec aa :: Annoted SPEC
aa ab :: Annoted SPEC
ab _ -> [Doc] -> Doc
fsep
      [String -> Doc
keyword String
localS, LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
aa, String -> Doc
keyword String
withinS, LogicGraph -> Annoted SPEC -> Doc
condBracesWithin LogicGraph
lg Annoted SPEC
ab]
    Closed_spec aa :: Annoted SPEC
aa _ -> [Doc] -> Doc
sep [String -> Doc
keyword String
closedS, LogicGraph -> Annoted SPEC -> Doc
printGroupSpec LogicGraph
lg Annoted SPEC
aa]
    Group aa :: Annoted SPEC
aa _ -> LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
aa
    Spec_inst aa :: IRI
aa ab :: [Annoted FIT_ARG]
ab mi :: Maybe IRI
mi _ -> let
      r :: Doc
r = [Doc] -> Doc
cat [IRI -> Doc
structIRI IRI
aa, LogicGraph -> [Annoted FIT_ARG] -> Doc
print_fit_arg_list LogicGraph
lg [Annoted FIT_ARG]
ab]
      in Doc -> (IRI -> Doc) -> Maybe IRI -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
r (\ i :: IRI
i -> [Doc] -> Doc
sep [Doc
r, IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i]) Maybe IRI
mi
    Qualified_spec ln :: LogicDescr
ln asp :: Annoted SPEC
asp _ -> LogicDescr -> Doc
forall a. Pretty a => a -> Doc
pretty LogicDescr
ln Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon
      Doc -> Doc -> Doc
$+$ LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG (LogicDescr -> LogicGraph -> LogicGraph
setLogicName LogicDescr
ln LogicGraph
lg) Annoted SPEC
asp
    Data ld :: AnyLogic
ld _ s1 :: Annoted SPEC
s1 s2 :: Annoted SPEC
s2 _ -> String -> Doc
keyword String
dataS
        Doc -> Doc -> Doc
<+> LogicGraph -> Annoted SPEC -> Doc
printGroupSpec (String -> LogicGraph -> LogicGraph
setCurLogic (AnyLogic -> String
forall a. Show a => a -> String
show AnyLogic
ld) LogicGraph
lg) Annoted SPEC
s1
        Doc -> Doc -> Doc
$+$ LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
s2
    Combination n :: Network
n _ -> [Doc] -> Doc
sep [String -> Doc
keyword String
combineS, Network -> Doc
forall a. Pretty a => a -> Doc
pretty Network
n]
    Apply i :: IRI
i bs :: G_basic_spec
bs _ ->
      [Doc] -> Doc
sep [String -> Doc
keyword "apply" Doc -> Doc -> Doc
<+> IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i, LogicGraph -> SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg (SPEC -> Doc) -> SPEC -> Doc
forall a b. (a -> b) -> a -> b
$ G_basic_spec -> Range -> SPEC
Basic_spec G_basic_spec
bs Range
nullRange]
    Bridge s1 :: Annoted SPEC
s1 rs :: [RENAMING]
rs s2 :: Annoted SPEC
s2 _ -> [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [LogicGraph -> Annoted SPEC -> Doc
condBraces LogicGraph
lg Annoted SPEC
s1, String -> Doc
keyword "bridge"]
      [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (RENAMING -> Doc) -> [RENAMING] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RENAMING -> Doc
forall a. Pretty a => a -> Doc
pretty [RENAMING]
rs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [LogicGraph -> Annoted SPEC -> Doc
condBraces LogicGraph
lg Annoted SPEC
s2]

instance Pretty Network where
    pretty :: Network -> Doc
pretty (Network cs :: [LABELED_ONTO_OR_INTPR_REF]
cs es :: [IRI]
es _) = [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [LABELED_ONTO_OR_INTPR_REF] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [LABELED_ONTO_OR_INTPR_REF]
cs
      Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: if [IRI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IRI]
es then [] else [String -> Doc
keyword String
excludingS, [IRI] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [IRI]
es]

instance Pretty FILTERING where
    pretty :: FILTERING -> Doc
pretty = FILTERING -> Doc
printFILTERING

printFILTERING :: FILTERING -> Doc
printFILTERING :: FILTERING -> Doc
printFILTERING (FilterBasicSpec b :: Bool
b aa :: G_basic_spec
aa _) =
   String -> Doc
keyword (if Bool
b then String
selectS else String
rejectS) Doc -> Doc -> Doc
<+> G_basic_spec -> Doc
forall a. Pretty a => a -> Doc
pretty G_basic_spec
aa
printFILTERING (FilterSymbolList b :: Bool
b aa :: G_symb_items_list
aa _) =
   String -> Doc
keyword (if Bool
b then String
selectS else String
rejectS) Doc -> Doc -> Doc
<+> G_symb_items_list -> Doc
forall a. Pretty a => a -> Doc
pretty G_symb_items_list
aa

instance Pretty MINIMIZATION where
    pretty :: MINIMIZATION -> Doc
pretty = MINIMIZATION -> Doc
printMINIMIZATION

printMINIMIZATION :: MINIMIZATION -> Doc
printMINIMIZATION :: MINIMIZATION -> Doc
printMINIMIZATION (Mini kw :: SIMPLE_ID
kw cms :: [IRI]
cms cvs :: [IRI]
cvs _) =
   [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
keyword (SIMPLE_ID -> String
tokStr SIMPLE_ID
kw) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (IRI -> Doc) -> [IRI] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IRI -> Doc
forall a. Pretty a => a -> Doc
pretty [IRI]
cms [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ if [IRI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IRI]
cvs then [] else
     String -> Doc
keyword "vars" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (IRI -> Doc) -> [IRI] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IRI -> Doc
forall a. Pretty a => a -> Doc
pretty [IRI]
cvs

instance Pretty APPROXIMATION where
    pretty :: APPROXIMATION -> Doc
pretty = APPROXIMATION -> Doc
printAPPROXIMATION

printAPPROXIMATION :: APPROXIMATION -> Doc
printAPPROXIMATION :: APPROXIMATION -> Doc
printAPPROXIMATION (ForgetOrKeep b :: Bool
b syms :: [G_hiding]
syms ml :: Maybe IRI
ml _) =
   [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
keyword (if Bool
b then String
forgetS else String
keepS)
   Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [G_hiding] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [G_hiding]
syms Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> (IRI -> [Doc]) -> Maybe IRI -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ i :: IRI
i -> [String -> Doc
keyword String
withS, IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i]) Maybe IRI
ml

instance Pretty EXTRACTION where
    pretty :: EXTRACTION -> Doc
pretty = EXTRACTION -> Doc
printEXTRACTION

printEXTRACTION :: EXTRACTION -> Doc
printEXTRACTION :: EXTRACTION -> Doc
printEXTRACTION (ExtractOrRemove b :: Bool
b aa :: [IRI]
aa _) =
   String -> Doc
keyword (if Bool
b then "extract" else "remove") Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((IRI -> Doc) -> [IRI] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IRI -> Doc
forall a. Pretty a => a -> Doc
pretty [IRI]
aa)

instance Pretty RENAMING where
    pretty :: RENAMING -> Doc
pretty = RENAMING -> Doc
printRENAMING

printRENAMING :: RENAMING -> Doc
printRENAMING :: RENAMING -> Doc
printRENAMING (Renaming aa :: [G_mapping]
aa _) =
   String -> Doc
keyword String
withS Doc -> Doc -> Doc
<+> [G_mapping] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [G_mapping]
aa

instance Pretty RESTRICTION where
    pretty :: RESTRICTION -> Doc
pretty = RESTRICTION -> Doc
printRESTRICTION

printRESTRICTION :: RESTRICTION -> Doc
printRESTRICTION :: RESTRICTION -> Doc
printRESTRICTION rest :: RESTRICTION
rest = case RESTRICTION
rest of
    Hidden aa :: [G_hiding]
aa _ -> String -> Doc
keyword String
hideS Doc -> Doc -> Doc
<+> [G_hiding] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [G_hiding]
aa
    Revealed aa :: G_symb_map_items_list
aa _ -> String -> Doc
keyword String
revealS Doc -> Doc -> Doc
<+> G_symb_map_items_list -> Doc
forall a. Pretty a => a -> Doc
pretty G_symb_map_items_list
aa

printLogicEncoding :: (Pretty a) => a -> Doc
printLogicEncoding :: a -> Doc
printLogicEncoding enc :: a
enc = String -> Doc
keyword String
logicS Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
enc

instance Pretty G_mapping where
    pretty :: G_mapping -> Doc
pretty = G_mapping -> Doc
printG_mapping

printG_mapping :: G_mapping -> Doc
printG_mapping :: G_mapping -> Doc
printG_mapping gma :: G_mapping
gma = case G_mapping
gma of
    G_symb_map gsmil :: G_symb_map_items_list
gsmil -> G_symb_map_items_list -> Doc
forall a. Pretty a => a -> Doc
pretty G_symb_map_items_list
gsmil
    G_logic_translation enc :: Logic_code
enc -> Logic_code -> Doc
forall a. Pretty a => a -> Doc
printLogicEncoding Logic_code
enc

instance Pretty G_hiding where
    pretty :: G_hiding -> Doc
pretty = G_hiding -> Doc
printG_hiding

printG_hiding :: G_hiding -> Doc
printG_hiding :: G_hiding -> Doc
printG_hiding ghid :: G_hiding
ghid = case G_hiding
ghid of
    G_symb_list gsil :: G_symb_items_list
gsil -> G_symb_items_list -> Doc
forall a. Pretty a => a -> Doc
pretty G_symb_items_list
gsil
    G_logic_projection enc :: Logic_code
enc -> Logic_code -> Doc
forall a. Pretty a => a -> Doc
printLogicEncoding Logic_code
enc

instance PrettyLG FIT_ARG where
    prettyLG :: LogicGraph -> FIT_ARG -> Doc
prettyLG = LogicGraph -> FIT_ARG -> Doc
printFIT_ARG

printFIT_ARG :: LogicGraph -> FIT_ARG -> Doc
printFIT_ARG :: LogicGraph -> FIT_ARG -> Doc
printFIT_ARG lg :: LogicGraph
lg fit :: FIT_ARG
fit = case FIT_ARG
fit of
    Fit_spec aa :: Annoted SPEC
aa ab :: [G_mapping]
ab _ ->
        let aa' :: Doc
aa' = Doc -> Doc
rmTopKey (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
aa
        in if [G_mapping] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [G_mapping]
ab then Doc
aa' else
               [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
aa' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: String -> Doc
keyword String
fitS
                        Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((G_mapping -> Doc) -> [G_mapping] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map G_mapping -> Doc
printG_mapping [G_mapping]
ab)
    Fit_view si :: IRI
si ab :: [Annoted FIT_ARG]
ab _ ->
        [Doc] -> Doc
sep [String -> Doc
keyword String
viewS, [Doc] -> Doc
cat [IRI -> Doc
structIRI IRI
si, LogicGraph -> [Annoted FIT_ARG] -> Doc
print_fit_arg_list LogicGraph
lg [Annoted FIT_ARG]
ab]]

instance Pretty Logic_code where
    pretty :: Logic_code -> Doc
pretty = Logic_code -> Doc
printLogic_code

printLogic_code :: Logic_code -> Doc
printLogic_code :: Logic_code -> Doc
printLogic_code (Logic_code menc :: Maybe String
menc msrc :: Maybe Logic_name
msrc mtar :: Maybe Logic_name
mtar _) =
   let pm :: Maybe Logic_name -> [Doc]
pm = [Doc] -> (Logic_name -> [Doc]) -> Maybe Logic_name -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: []) (Doc -> [Doc]) -> (Logic_name -> Doc) -> Logic_name -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logic_name -> Doc
printLogic_name) in
   [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> (String -> [Doc]) -> Maybe String -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc
colon]) (Doc -> [Doc]) -> (String -> Doc) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe String
menc
        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe Logic_name -> [Doc]
pm Maybe Logic_name
msrc [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Doc
funArrow Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Maybe Logic_name -> [Doc]
pm Maybe Logic_name
mtar

instance Pretty LogicDescr where
    pretty :: LogicDescr -> Doc
pretty ld :: LogicDescr
ld = case LogicDescr
ld of
      LogicDescr n :: Logic_name
n s :: Maybe IRI
s _ -> [Doc] -> Doc
sep [String -> Doc
keyword String
logicS, Logic_name -> Doc
forall a. Pretty a => a -> Doc
pretty Logic_name
n,
        Doc -> (IRI -> Doc) -> Maybe IRI -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\ r :: IRI
r -> [Doc] -> Doc
sep [String -> Doc
keyword String
serializationS, IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
r]) Maybe IRI
s]
      SyntaxQual i :: IRI
i -> [Doc] -> Doc
sep [String -> Doc
keyword String
serializationS, IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i]
      LanguageQual i :: IRI
i -> [Doc] -> Doc
sep [String -> Doc
keyword "language", IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i]

instance Pretty Logic_name where
    pretty :: Logic_name -> Doc
pretty = Logic_name -> Doc
printLogic_name

printLogic_name :: Logic_name -> Doc
printLogic_name :: Logic_name -> Doc
printLogic_name (Logic_name mlog :: String
mlog slog :: Maybe SIMPLE_ID
slog ms :: Maybe IRI
ms) = let d :: Doc
d = String -> Doc
structId String
mlog in
    case Maybe SIMPLE_ID
slog of
      Nothing -> Doc
d
      Just sub :: SIMPLE_ID
sub -> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SIMPLE_ID -> Doc
sublogicId SIMPLE_ID
sub
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> (IRI -> Doc) -> Maybe IRI -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens (Doc -> Doc) -> (IRI -> Doc) -> IRI -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe IRI
ms

instance Pretty LABELED_ONTO_OR_INTPR_REF where
    pretty :: LABELED_ONTO_OR_INTPR_REF -> Doc
pretty = LABELED_ONTO_OR_INTPR_REF -> Doc
printLIRI

printLIRI :: LABELED_ONTO_OR_INTPR_REF -> Doc
printLIRI :: LABELED_ONTO_OR_INTPR_REF -> Doc
printLIRI (Labeled n :: Maybe SIMPLE_ID
n i :: IRI
i) = case Maybe SIMPLE_ID
n of
    Just x :: SIMPLE_ID
x -> SIMPLE_ID -> Doc
forall a. Pretty a => a -> Doc
pretty SIMPLE_ID
x Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i
    Nothing -> IRI -> Doc
forall a. Pretty a => a -> Doc
pretty IRI
i

{- |
  specialized printing of 'FIT_ARG's
-}
print_fit_arg_list :: LogicGraph -> [Annoted FIT_ARG] -> Doc
print_fit_arg_list :: LogicGraph -> [Annoted FIT_ARG] -> Doc
print_fit_arg_list lg :: LogicGraph
lg = [Doc] -> Doc
cat ([Doc] -> Doc)
-> ([Annoted FIT_ARG] -> [Doc]) -> [Annoted FIT_ARG] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annoted FIT_ARG -> Doc) -> [Annoted FIT_ARG] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets (Doc -> Doc) -> (Annoted FIT_ARG -> Doc) -> Annoted FIT_ARG -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicGraph -> Annoted FIT_ARG -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg)

{- |
   conditional generation of grouping braces for Union and Extension
-}
printGroupSpec :: LogicGraph -> Annoted SPEC -> Doc
printGroupSpec :: LogicGraph -> Annoted SPEC -> Doc
printGroupSpec lg :: LogicGraph
lg s :: Annoted SPEC
s = let d :: Doc
d = LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
s in
    case SPEC -> SPEC
skip_Group (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
s of
                 Spec_inst {} -> Doc
d
                 _ -> Doc -> Doc
specBraces Doc
d

{- |
  generate grouping braces for Tanslations and Reductions
-}
condBracesTransReduct :: LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct :: LogicGraph -> Annoted SPEC -> Doc
condBracesTransReduct lg :: LogicGraph
lg s :: Annoted SPEC
s = let d :: Doc
d = LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
s in
    case SPEC -> SPEC
skip_Group (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
s of
                 Bridge {} -> Doc -> Doc
specBraces Doc
d
                 Extension {} -> Doc -> Doc
specBraces Doc
d
                 Union {} -> Doc -> Doc
specBraces Doc
d
                 Intersection {} -> Doc -> Doc
specBraces Doc
d
                 Local_spec {} -> Doc -> Doc
specBraces Doc
d
                 _ -> Doc
d

{- |
  generate grouping braces for Within
-}
condBracesWithin :: LogicGraph -> Annoted SPEC -> Doc
condBracesWithin :: LogicGraph -> Annoted SPEC -> Doc
condBracesWithin lg :: LogicGraph
lg s :: Annoted SPEC
s = let d :: Doc
d = LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
s in
    case SPEC -> SPEC
skip_Group (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
s of
                 Bridge {} -> Doc -> Doc
specBraces Doc
d
                 Extension {} -> Doc -> Doc
specBraces Doc
d
                 Union {} -> Doc -> Doc
specBraces Doc
d
                 Intersection {} -> Doc -> Doc
specBraces Doc
d
                 _ -> Doc
d
{- |
  only Extensions inside of Unions (and) need grouping braces
-}
condBracesAnd :: LogicGraph -> Annoted SPEC -> Doc
condBracesAnd :: LogicGraph -> Annoted SPEC -> Doc
condBracesAnd lg :: LogicGraph
lg s :: Annoted SPEC
s = let d :: Doc
d = LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
s in
    case SPEC -> SPEC
skip_Group (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
s of
                 Bridge {} -> Doc -> Doc
specBraces Doc
d
                 Extension {} -> Doc -> Doc
specBraces Doc
d
                 _ -> Doc
d

-- bridges inside bridges need grouping
condBraces :: LogicGraph -> Annoted SPEC -> Doc
condBraces :: LogicGraph -> Annoted SPEC -> Doc
condBraces lg :: LogicGraph
lg s :: Annoted SPEC
s = let d :: Doc
d = LogicGraph -> Annoted SPEC -> Doc
forall a. PrettyLG a => LogicGraph -> a -> Doc
prettyLG LogicGraph
lg Annoted SPEC
s in
    case SPEC -> SPEC
skip_Group (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
s of
                 Bridge {} -> Doc -> Doc
specBraces Doc
d
                 _ -> Doc
d

-- | only skip groups without annotations
skipVoidGroup :: SPEC -> SPEC
skipVoidGroup :: SPEC -> SPEC
skipVoidGroup sp :: SPEC
sp =
    case SPEC
sp of
            Group g :: Annoted SPEC
g _ | [Annotation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Annoted SPEC -> [Annotation]
forall a. Annoted a -> [Annotation]
l_annos Annoted SPEC
g) Bool -> Bool -> Bool
&& [Annotation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Annoted SPEC -> [Annotation]
forall a. Annoted a -> [Annotation]
r_annos Annoted SPEC
g)
                          -> SPEC -> SPEC
skipVoidGroup (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
g
            _ -> SPEC
sp

-- | skip nested groups
skip_Group :: SPEC -> SPEC
skip_Group :: SPEC -> SPEC
skip_Group sp :: SPEC
sp =
    case SPEC
sp of
            Group g :: Annoted SPEC
g _ -> SPEC -> SPEC
skip_Group (SPEC -> SPEC) -> SPEC -> SPEC
forall a b. (a -> b) -> a -> b
$ Annoted SPEC -> SPEC
forall a. Annoted a -> a
item Annoted SPEC
g
            _ -> SPEC
sp