{- |
Module      :  ./FreeCAD/PrintAs.hs
Description :  print the abstract syntax of FreeCAD terms
Copyright   :  (c) Robert Savu and Uni Bremen 2011
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Robert.Savu@dfki.de
Stability   :  experimental
Portability :  portable

Printing of the abstract syntax of FreeCAD terms
-}

module FreeCAD.PrintAs where

import FreeCAD.As
import Common.DocUtils
import Common.Doc
import Common.Id

-- | Pretty printing 'Double'
instance Pretty Double where
    pretty :: Double -> Doc
pretty = Token -> Doc
sidDoc (Token -> Doc) -> (Double -> Token) -> Double -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
mkSimpleId (String -> Token) -> (Double -> String) -> Double -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show

instance Pretty Vector3 where
    pretty :: Vector3 -> Doc
pretty v :: Vector3
v = (Double, Double, Double) -> Doc
forall a. Pretty a => a -> Doc
pretty (Vector3 -> Double
x Vector3
v, Vector3 -> Double
y Vector3
v, Vector3 -> Double
z Vector3
v)

instance Pretty Matrix33 where
    pretty :: Matrix33 -> Doc
pretty m :: Matrix33
m = [Doc] -> Doc
vcat [Doc
lparen Doc -> Doc -> Doc
<+> Doc
rows, Doc
rparen] where
                         rows :: Doc
rows = [Doc] -> Doc
vcat [Doc
row1, Doc
row2, Doc
row3]
                         row :: (Matrix33 -> a) -> (Matrix33 -> a) -> (Matrix33 -> a) -> Doc
row a :: Matrix33 -> a
a b :: Matrix33 -> a
b c :: Matrix33 -> a
c = [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [Matrix33 -> a
a Matrix33
m, Matrix33 -> a
b Matrix33
m, Matrix33 -> a
c Matrix33
m]
                         row1 :: Doc
row1 = (Matrix33 -> Double)
-> (Matrix33 -> Double) -> (Matrix33 -> Double) -> Doc
forall a.
Pretty a =>
(Matrix33 -> a) -> (Matrix33 -> a) -> (Matrix33 -> a) -> Doc
row Matrix33 -> Double
a11 Matrix33 -> Double
a12 Matrix33 -> Double
a13
                         row2 :: Doc
row2 = (Matrix33 -> Double)
-> (Matrix33 -> Double) -> (Matrix33 -> Double) -> Doc
forall a.
Pretty a =>
(Matrix33 -> a) -> (Matrix33 -> a) -> (Matrix33 -> a) -> Doc
row Matrix33 -> Double
a21 Matrix33 -> Double
a22 Matrix33 -> Double
a23
                         row3 :: Doc
row3 = (Matrix33 -> Double)
-> (Matrix33 -> Double) -> (Matrix33 -> Double) -> Doc
forall a.
Pretty a =>
(Matrix33 -> a) -> (Matrix33 -> a) -> (Matrix33 -> a) -> Doc
row Matrix33 -> Double
a31 Matrix33 -> Double
a32 Matrix33 -> Double
a33


instance Pretty Vector4 where
    pretty :: Vector4 -> Doc
pretty v :: Vector4
v = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Double -> Doc) -> [Double] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Doc
forall a. Pretty a => a -> Doc
pretty [Vector4 -> Double
q0 Vector4
v, Vector4 -> Double
q1 Vector4
v, Vector4 -> Double
q2 Vector4
v, Vector4 -> Double
q3 Vector4
v]

instance Pretty Placement where
    pretty :: Placement -> Doc
pretty p1 :: Placement
p1 =
      Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepBySemis [Vector3 -> Doc
forall a. Pretty a => a -> Doc
pretty (Vector3 -> Doc) -> Vector3 -> Doc
forall a b. (a -> b) -> a -> b
$ Placement -> Vector3
position Placement
p1, Vector4 -> Doc
forall a. Pretty a => a -> Doc
pretty (Vector4 -> Doc) -> Vector4 -> Doc
forall a b. (a -> b) -> a -> b
$ Placement -> Vector4
orientation Placement
p1]

printBO :: BaseObject -> Doc
printBO :: BaseObject -> Doc
printBO (Box h :: Double
h w :: Double
w l :: Double
l) = String -> Doc
text "Box" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [Doc
hrow, Doc
wrow, Doc
lrow] where
        hrow :: Doc
hrow = [Doc] -> Doc
hcat [ String -> Doc
text "Height ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
h]
        wrow :: Doc
wrow = [Doc] -> Doc
hcat [ String -> Doc
text "Width  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
w]
        lrow :: Doc
lrow = [Doc] -> Doc
hcat [ String -> Doc
text "Length ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
l]
printBO (Cylinder a :: Double
a h :: Double
h r :: Double
r) = String -> Doc
text "Cylinder" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [Doc
arow, Doc
hrow, Doc
rrow] where
        arow :: Doc
arow = [Doc] -> Doc
hcat [ String -> Doc
text "Angle  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a]
        hrow :: Doc
hrow = [Doc] -> Doc
hcat [ String -> Doc
text "Heigth ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
h]
        rrow :: Doc
rrow = [Doc] -> Doc
hcat [ String -> Doc
text "Radius ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
r]
printBO (Sphere a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 r :: Double
r) = String -> Doc
text "Sphere" Doc -> Doc -> Doc
<+>
                              [Doc] -> Doc
vcat [Doc
a1row, Doc
a2row, Doc
a3row, Doc
rrow] where
        a1row :: Doc
a1row = [Doc] -> Doc
hcat [ String -> Doc
text "Angle1 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a1]
        a2row :: Doc
a2row = [Doc] -> Doc
hcat [ String -> Doc
text "Angle2 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a2]
        a3row :: Doc
a3row = [Doc] -> Doc
hcat [ String -> Doc
text "Angle3 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a3]
        rrow :: Doc
rrow = [Doc] -> Doc
hcat [ String -> Doc
text "Radius ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
r]
printBO (Cone a :: Double
a r1 :: Double
r1 r2 :: Double
r2 h :: Double
h) = String -> Doc
text "Cone" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [Doc
arow, Doc
brow, Doc
hrow, Doc
rrow] where
        arow :: Doc
arow = [Doc] -> Doc
hcat [ String -> Doc
text "Angle   ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a]
        brow :: Doc
brow = [Doc] -> Doc
hcat [ String -> Doc
text "Radius1 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
r1]
        hrow :: Doc
hrow = [Doc] -> Doc
hcat [ String -> Doc
text "Radius2 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
r2]
        rrow :: Doc
rrow = [Doc] -> Doc
hcat [ String -> Doc
text "Heigth  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
h]
printBO (Torus t1 :: Double
t1 t2 :: Double
t2 t3 :: Double
t3 t4 :: Double
t4 t5 :: Double
t5) = String -> Doc
text "Torus" Doc -> Doc -> Doc
<+>
                                 [Doc] -> Doc
vcat [Doc
t1r, Doc
t2r, Doc
t3r, Doc
t4r, Doc
t5r] where
        t1r :: Doc
t1r = [Doc] -> Doc
hcat [ String -> Doc
text "Angle1  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
t1]
        t2r :: Doc
t2r = [Doc] -> Doc
hcat [ String -> Doc
text "Angle2  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
t2]
        t3r :: Doc
t3r = [Doc] -> Doc
hcat [ String -> Doc
text "Angle3  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
t3]
        t4r :: Doc
t4r = [Doc] -> Doc
hcat [ String -> Doc
text "Radius1 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
t4]
        t5r :: Doc
t5r = [Doc] -> Doc
hcat [ String -> Doc
text "Radius2 ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
t5]
printBO (Line a :: Double
a) = String -> Doc
text "Line" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat [ String -> Doc
text "Length ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a]
printBO (Circle a :: Double
a h :: Double
h r :: Double
r) = String -> Doc
text "Circle" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [Doc
arow, Doc
hrow, Doc
rrow] where
        arow :: Doc
arow = [Doc] -> Doc
hcat [ String -> Doc
text "sAngle  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
a]
        hrow :: Doc
hrow = [Doc] -> Doc
hcat [ String -> Doc
text "eAngle  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
h]
        rrow :: Doc
rrow = [Doc] -> Doc
hcat [ String -> Doc
text "Radius ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
r]
printBO (Rectangle h :: Double
h w :: Double
w) = String -> Doc
text "Rectangle" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [Doc
hrow, Doc
wrow] where
        hrow :: Doc
hrow = [Doc] -> Doc
hcat [ String -> Doc
text "Heigth ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
h]
        wrow :: Doc
wrow = [Doc] -> Doc
hcat [ String -> Doc
text "Width  ", Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
w]

instance Pretty BaseObject where
    pretty :: BaseObject -> Doc
pretty = BaseObject -> Doc
printBO

printObject :: Object -> Doc
printObject :: Object -> Doc
printObject (BaseObject bo :: BaseObject
bo) = BaseObject -> Doc
forall a. Pretty a => a -> Doc
pretty BaseObject
bo
printObject ( Cut eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2) = String -> Doc
text "Cut" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo1, ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo2]
printObject ( Common eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2) = String -> Doc
text "Common" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo1, ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo2]
printObject ( Fusion eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2) = String -> Doc
text "Fusion" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo1, ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo2]
printObject ( Section eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2) = String -> Doc
text "Section" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo1, ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo2]
printObject ( Extrusion eo :: ExtendedObject
eo d :: Vector3
d) = String -> Doc
text "Extrusion" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [ExtendedObject -> Doc
forall a. Pretty a => a -> Doc
pretty ExtendedObject
eo, Vector3 -> Doc
forall a. Pretty a => a -> Doc
pretty Vector3
d]

instance Pretty Object where
    pretty :: Object -> Doc
pretty = Object -> Doc
printObject

printEO :: ExtendedObject -> Doc
printEO :: ExtendedObject -> Doc
printEO (Placed po :: PlacedObject
po) = PlacedObject -> Doc
forall a. Pretty a => a -> Doc
pretty PlacedObject
po
printEO (Ref s :: String
s) = String -> Doc
text String
s

printPO :: PlacedObject -> Doc
printPO :: PlacedObject -> Doc
printPO (PlacedObject plc :: Placement
plc obj :: Object
obj) = [Doc] -> Doc
vcat [Object -> Doc
forall a. Pretty a => a -> Doc
pretty Object
obj, String -> Doc
text "place" Doc -> Doc -> Doc
<+> Placement -> Doc
forall a. Pretty a => a -> Doc
pretty Placement
plc]

printDoc :: Document -> Doc
printDoc :: Document -> Doc
printDoc a :: Document
a = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (NamedObject -> Doc) -> Document -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map NamedObject -> Doc
forall a. Pretty a => a -> Doc
pretty Document
a

instance Pretty ExtendedObject where
    pretty :: ExtendedObject -> Doc
pretty = ExtendedObject -> Doc
printEO

instance Pretty PlacedObject where
    pretty :: PlacedObject -> Doc
pretty = PlacedObject -> Doc
printPO

instance Pretty NamedObject where
    pretty :: NamedObject -> Doc
pretty no :: NamedObject
no = Doc
lbrack Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+>
        [Doc] -> Doc
hcat [Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
forall a. Pretty a => a -> Doc
pretty (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ NamedObject -> String
name NamedObject
no, Doc
colon, Doc
space, PlacedObject -> Doc
forall a. Pretty a => a -> Doc
pretty (PlacedObject -> Doc) -> PlacedObject -> Doc
forall a b. (a -> b) -> a -> b
$ NamedObject -> PlacedObject
object NamedObject
no]
        Doc -> Doc -> Doc
$+$ Doc
rbrack

instance GetRange NamedObject

instance Pretty Sign where
    pretty :: Sign -> Doc
pretty = Set NamedObject -> Doc
forall a. Pretty a => a -> Doc
pretty (Set NamedObject -> Doc)
-> (Sign -> Set NamedObject) -> Sign -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sign -> Set NamedObject
objects