{-# OPTIONS -w -O0 #-}
{-# LANGUAGE CPP, StandaloneDeriving, DeriveDataTypeable, DeriveGeneric #-}
{- |
Module      :  FreeCAD/ATC_FreeCAD.der.hs
Description :  generated ShATermConvertible, Json instances
Copyright   :  (c) DFKI GmbH 2012
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable(derive Typeable instances)

Automatic derivation of instances via DrIFT-rule ShATermConvertible, Json
  for the type(s):
'FreeCAD.As.Vector3'
'FreeCAD.As.Matrix33'
'FreeCAD.As.Vector4'
'FreeCAD.As.Placement'
'FreeCAD.As.BaseObject'
'FreeCAD.As.Object'
'FreeCAD.As.ExtendedObject'
'FreeCAD.As.PlacedObject'
'FreeCAD.As.NamedObject'
'FreeCAD.As.Sign'
-}

{-
Generated by 'genRules' (automatic rule generation for DrIFT). Don't touch!!
  dependency files:
FreeCAD/As.hs
-}

module FreeCAD.ATC_FreeCAD () where

import ATerm.Lib
import Common.ATerm.ConvInstances
import Common.Json.ConvInstances
import Common.Json.Instances
import Data.Aeson(ToJSON, FromJSON)
import Data.Data
import FreeCAD.As
import GHC.Generics(Generic)
import qualified Data.Set as Set

{-! for FreeCAD.As.Vector3 derive : ShATermConvertible !-}
{-! for FreeCAD.As.Matrix33 derive : ShATermConvertible !-}
{-! for FreeCAD.As.Vector4 derive : ShATermConvertible !-}
{-! for FreeCAD.As.Placement derive : ShATermConvertible !-}
{-! for FreeCAD.As.BaseObject derive : ShATermConvertible !-}
{-! for FreeCAD.As.Object derive : ShATermConvertible !-}
{-! for FreeCAD.As.ExtendedObject derive : ShATermConvertible !-}
{-! for FreeCAD.As.PlacedObject derive : ShATermConvertible !-}
{-! for FreeCAD.As.NamedObject derive : ShATermConvertible !-}
{-! for FreeCAD.As.Sign derive : ShATermConvertible !-}

{-! for FreeCAD.As.Vector3 derive : Json !-}
{-! for FreeCAD.As.Matrix33 derive : Json !-}
{-! for FreeCAD.As.Vector4 derive : Json !-}
{-! for FreeCAD.As.Placement derive : Json !-}
{-! for FreeCAD.As.BaseObject derive : Json !-}
{-! for FreeCAD.As.Object derive : Json !-}
{-! for FreeCAD.As.ExtendedObject derive : Json !-}
{-! for FreeCAD.As.PlacedObject derive : Json !-}
{-! for FreeCAD.As.NamedObject derive : Json !-}
{-! for FreeCAD.As.Sign derive : Json !-}

-- Generated by DrIFT, look but don't touch!

deriving instance GHC.Generics.Generic FreeCAD.As.Sign
instance Data.Aeson.ToJSON FreeCAD.As.Sign where
instance Data.Aeson.FromJSON FreeCAD.As.Sign where

deriving instance GHC.Generics.Generic FreeCAD.As.NamedObject
instance Data.Aeson.ToJSON FreeCAD.As.NamedObject where
instance Data.Aeson.FromJSON FreeCAD.As.NamedObject where

deriving instance GHC.Generics.Generic FreeCAD.As.PlacedObject
instance Data.Aeson.ToJSON FreeCAD.As.PlacedObject where
instance Data.Aeson.FromJSON FreeCAD.As.PlacedObject where

deriving instance GHC.Generics.Generic FreeCAD.As.ExtendedObject
instance Data.Aeson.ToJSON FreeCAD.As.ExtendedObject where
instance Data.Aeson.FromJSON FreeCAD.As.ExtendedObject where

deriving instance GHC.Generics.Generic FreeCAD.As.Object
instance Data.Aeson.ToJSON FreeCAD.As.Object where
instance Data.Aeson.FromJSON FreeCAD.As.Object where

deriving instance GHC.Generics.Generic FreeCAD.As.BaseObject
instance Data.Aeson.ToJSON FreeCAD.As.BaseObject where
instance Data.Aeson.FromJSON FreeCAD.As.BaseObject where

deriving instance GHC.Generics.Generic FreeCAD.As.Placement
instance Data.Aeson.ToJSON FreeCAD.As.Placement where
instance Data.Aeson.FromJSON FreeCAD.As.Placement where

deriving instance GHC.Generics.Generic FreeCAD.As.Vector4
instance Data.Aeson.ToJSON FreeCAD.As.Vector4 where
instance Data.Aeson.FromJSON FreeCAD.As.Vector4 where

deriving instance GHC.Generics.Generic FreeCAD.As.Matrix33
instance Data.Aeson.ToJSON FreeCAD.As.Matrix33 where
instance Data.Aeson.FromJSON FreeCAD.As.Matrix33 where

deriving instance GHC.Generics.Generic FreeCAD.As.Vector3
instance Data.Aeson.ToJSON FreeCAD.As.Vector3 where
instance Data.Aeson.FromJSON FreeCAD.As.Vector3 where

instance ShATermConvertible FreeCAD.As.Sign where
  toShATermAux :: ATermTable -> Sign -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Sign
xv = case Sign
xv of
    Sign a :: Set NamedObject
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Set NamedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Set NamedObject
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Sign" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Sign)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Sign" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Set NamedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Set NamedObject
a') ->
      (ATermTable
att1, Set NamedObject -> Sign
Sign Set NamedObject
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Sign)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.Sign" ShATerm
u

instance ShATermConvertible FreeCAD.As.NamedObject where
  toShATermAux :: ATermTable -> NamedObject -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: NamedObject
xv = case NamedObject
xv of
    NamedObject a :: String
a b :: PlacedObject
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> PlacedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 PlacedObject
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "NamedObject" [Int
a', Int
b'] []) ATermTable
att2
    EmptyObject -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "EmptyObject" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, NamedObject)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "NamedObject" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, PlacedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: PlacedObject
b') ->
      (ATermTable
att2, String -> PlacedObject -> NamedObject
NamedObject String
a' PlacedObject
b') }}
    ShAAppl "EmptyObject" [] _ -> (ATermTable
att0, NamedObject
EmptyObject)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, NamedObject)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.NamedObject" ShATerm
u

instance ShATermConvertible FreeCAD.As.PlacedObject where
  toShATermAux :: ATermTable -> PlacedObject -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: PlacedObject
xv = case PlacedObject
xv of
    PlacedObject a :: Placement
a b :: Object
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Placement -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Placement
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Object -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Object
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "PlacedObject" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, PlacedObject)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "PlacedObject" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Placement)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Placement
a') ->
      case Int -> ATermTable -> (ATermTable, Object)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Object
b') ->
      (ATermTable
att2, Placement -> Object -> PlacedObject
PlacedObject Placement
a' Object
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, PlacedObject)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.PlacedObject" ShATerm
u

instance ShATermConvertible FreeCAD.As.ExtendedObject where
  toShATermAux :: ATermTable -> ExtendedObject -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: ExtendedObject
xv = case ExtendedObject
xv of
    Placed a :: PlacedObject
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> PlacedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 PlacedObject
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Placed" [Int
a'] []) ATermTable
att1
    Ref a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Ref" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, ExtendedObject)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Placed" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, PlacedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: PlacedObject
a') ->
      (ATermTable
att1, PlacedObject -> ExtendedObject
Placed PlacedObject
a') }
    ShAAppl "Ref" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> ExtendedObject
Ref String
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, ExtendedObject)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.ExtendedObject" ShATerm
u

instance ShATermConvertible FreeCAD.As.Object where
  toShATermAux :: ATermTable -> Object -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Object
xv = case Object
xv of
    BaseObject a :: BaseObject
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> BaseObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 BaseObject
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "BaseObject" [Int
a'] []) ATermTable
att1
    Cut a :: ExtendedObject
a b :: ExtendedObject
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 ExtendedObject
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 ExtendedObject
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Cut" [Int
a', Int
b'] []) ATermTable
att2
    Common a :: ExtendedObject
a b :: ExtendedObject
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 ExtendedObject
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 ExtendedObject
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Common" [Int
a', Int
b'] []) ATermTable
att2
    Fusion a :: ExtendedObject
a b :: ExtendedObject
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 ExtendedObject
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 ExtendedObject
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Fusion" [Int
a', Int
b'] []) ATermTable
att2
    Extrusion a :: ExtendedObject
a b :: Vector3
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 ExtendedObject
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Vector3 -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Vector3
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Extrusion" [Int
a', Int
b'] []) ATermTable
att2
    Section a :: ExtendedObject
a b :: ExtendedObject
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 ExtendedObject
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> ExtendedObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 ExtendedObject
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Section" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Object)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "BaseObject" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, BaseObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: BaseObject
a') ->
      (ATermTable
att1, BaseObject -> Object
BaseObject BaseObject
a') }
    ShAAppl "Cut" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: ExtendedObject
a') ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: ExtendedObject
b') ->
      (ATermTable
att2, ExtendedObject -> ExtendedObject -> Object
Cut ExtendedObject
a' ExtendedObject
b') }}
    ShAAppl "Common" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: ExtendedObject
a') ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: ExtendedObject
b') ->
      (ATermTable
att2, ExtendedObject -> ExtendedObject -> Object
Common ExtendedObject
a' ExtendedObject
b') }}
    ShAAppl "Fusion" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: ExtendedObject
a') ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: ExtendedObject
b') ->
      (ATermTable
att2, ExtendedObject -> ExtendedObject -> Object
Fusion ExtendedObject
a' ExtendedObject
b') }}
    ShAAppl "Extrusion" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: ExtendedObject
a') ->
      case Int -> ATermTable -> (ATermTable, Vector3)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Vector3
b') ->
      (ATermTable
att2, ExtendedObject -> Vector3 -> Object
Extrusion ExtendedObject
a' Vector3
b') }}
    ShAAppl "Section" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: ExtendedObject
a') ->
      case Int -> ATermTable -> (ATermTable, ExtendedObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: ExtendedObject
b') ->
      (ATermTable
att2, ExtendedObject -> ExtendedObject -> Object
Section ExtendedObject
a' ExtendedObject
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Object)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.Object" ShATerm
u

instance ShATermConvertible FreeCAD.As.BaseObject where
  toShATermAux :: ATermTable -> BaseObject -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: BaseObject
xv = case BaseObject
xv of
    Box a :: Double
a b :: Double
b c :: Double
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Box" [Int
a', Int
b', Int
c'] []) ATermTable
att3
    Cylinder a :: Double
a b :: Double
b c :: Double
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Cylinder" [Int
a', Int
b', Int
c'] []) ATermTable
att3
    Sphere a :: Double
a b :: Double
b c :: Double
c d :: Double
d -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Double
d
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Sphere" [Int
a', Int
b', Int
c', Int
d'] []) ATermTable
att4
    Cone a :: Double
a b :: Double
b c :: Double
c d :: Double
d -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Double
d
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Cone" [Int
a', Int
b', Int
c', Int
d'] []) ATermTable
att4
    Torus a :: Double
a b :: Double
b c :: Double
c d :: Double
d e :: Double
e -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Double
d
      (att5 :: ATermTable
att5, e' :: Int
e') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att4 Double
e
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Torus" [Int
a', Int
b', Int
c', Int
d', Int
e'] []) ATermTable
att5
    Line a :: Double
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Line" [Int
a'] []) ATermTable
att1
    Circle a :: Double
a b :: Double
b c :: Double
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Circle" [Int
a', Int
b', Int
c'] []) ATermTable
att3
    Rectangle a :: Double
a b :: Double
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Rectangle" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, BaseObject)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Box" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      (ATermTable
att3, Double -> Double -> Double -> BaseObject
Box Double
a' Double
b' Double
c') }}}
    ShAAppl "Cylinder" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      (ATermTable
att3, Double -> Double -> Double -> BaseObject
Cylinder Double
a' Double
b' Double
c') }}}
    ShAAppl "Sphere" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Double
d') ->
      (ATermTable
att4, Double -> Double -> Double -> Double -> BaseObject
Sphere Double
a' Double
b' Double
c' Double
d') }}}}
    ShAAppl "Cone" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Double
d') ->
      (ATermTable
att4, Double -> Double -> Double -> Double -> BaseObject
Cone Double
a' Double
b' Double
c' Double
d') }}}}
    ShAAppl "Torus" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d, e :: Int
e] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Double
d') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
e ATermTable
att4 of
      { (att5 :: ATermTable
att5, e' :: Double
e') ->
      (ATermTable
att5, Double -> Double -> Double -> Double -> Double -> BaseObject
Torus Double
a' Double
b' Double
c' Double
d' Double
e') }}}}}
    ShAAppl "Line" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      (ATermTable
att1, Double -> BaseObject
Line Double
a') }
    ShAAppl "Circle" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      (ATermTable
att3, Double -> Double -> Double -> BaseObject
Circle Double
a' Double
b' Double
c') }}}
    ShAAppl "Rectangle" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      (ATermTable
att2, Double -> Double -> BaseObject
Rectangle Double
a' Double
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, BaseObject)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.BaseObject" ShATerm
u

instance ShATermConvertible FreeCAD.As.Placement where
  toShATermAux :: ATermTable -> Placement -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Placement
xv = case Placement
xv of
    Placement a :: Vector3
a b :: Vector4
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Vector3 -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Vector3
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Vector4 -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Vector4
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Placement" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Placement)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Placement" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Vector3)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Vector3
a') ->
      case Int -> ATermTable -> (ATermTable, Vector4)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Vector4
b') ->
      (ATermTable
att2, Vector3 -> Vector4 -> Placement
Placement Vector3
a' Vector4
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Placement)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.Placement" ShATerm
u

instance ShATermConvertible FreeCAD.As.Vector4 where
  toShATermAux :: ATermTable -> Vector4 -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Vector4
xv = case Vector4
xv of
    Vector4 a :: Double
a b :: Double
b c :: Double
c d :: Double
d -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Double
d
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Vector4" [Int
a', Int
b', Int
c', Int
d'] []) ATermTable
att4
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Vector4)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Vector4" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Double
d') ->
      (ATermTable
att4, Double -> Double -> Double -> Double -> Vector4
Vector4 Double
a' Double
b' Double
c' Double
d') }}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Vector4)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.Vector4" ShATerm
u

instance ShATermConvertible FreeCAD.As.Matrix33 where
  toShATermAux :: ATermTable -> Matrix33 -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Matrix33
xv = case Matrix33
xv of
    Matrix33 a :: Double
a b :: Double
b c :: Double
c d :: Double
d e :: Double
e f :: Double
f g :: Double
g h :: Double
h i :: Double
i -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Double
d
      (att5 :: ATermTable
att5, e' :: Int
e') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att4 Double
e
      (att6 :: ATermTable
att6, f' :: Int
f') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att5 Double
f
      (att7 :: ATermTable
att7, g' :: Int
g') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att6 Double
g
      (att8 :: ATermTable
att8, h' :: Int
h') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att7 Double
h
      (att9 :: ATermTable
att9, i' :: Int
i') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att8 Double
i
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Matrix33" [Int
a', Int
b', Int
c', Int
d', Int
e', Int
f', Int
g',
                                             Int
h', Int
i'] []) ATermTable
att9
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Matrix33)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Matrix33" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d, e :: Int
e, f :: Int
f, g :: Int
g, h :: Int
h, i :: Int
i] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Double
d') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
e ATermTable
att4 of
      { (att5 :: ATermTable
att5, e' :: Double
e') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
f ATermTable
att5 of
      { (att6 :: ATermTable
att6, f' :: Double
f') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
g ATermTable
att6 of
      { (att7 :: ATermTable
att7, g' :: Double
g') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
h ATermTable
att7 of
      { (att8 :: ATermTable
att8, h' :: Double
h') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
i ATermTable
att8 of
      { (att9 :: ATermTable
att9, i' :: Double
i') ->
      (ATermTable
att9, Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Matrix33
Matrix33 Double
a' Double
b' Double
c' Double
d' Double
e' Double
f' Double
g' Double
h' Double
i') }}}}}}}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Matrix33)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.Matrix33" ShATerm
u

instance ShATermConvertible FreeCAD.As.Vector3 where
  toShATermAux :: ATermTable -> Vector3 -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Vector3
xv = case Vector3
xv of
    Vector3 a :: Double
a b :: Double
b c :: Double
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Double
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Double
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Double -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Double
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Vector3" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Vector3)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Vector3" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Double
a') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Double
b') ->
      case Int -> ATermTable -> (ATermTable, Double)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Double
c') ->
      (ATermTable
att3, Double -> Double -> Double -> Vector3
Vector3 Double
a' Double
b' Double
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Vector3)
forall a. String -> ShATerm -> a
fromShATermError "FreeCAD.As.Vector3" ShATerm
u