@@ -28,6 +28,15 @@ import Data.Certificate.X509 (X509)
2828import Control.Monad.Trans.Resource (ResourceT)
2929import Control.Monad.IO.Class (liftIO)
3030import Control.Arrow.ArrowList (listA)
31+import Text.PrettyPrint
32+ ( Doc
33+ , text
34+ , (<+>)
35+ , ($$)
36+ , vcat
37+ , hang
38+ , doubleQuotes
39+ )
3140import Network.HTTP.Conduit
3241 ( parseUrl
3342 , clientCertificates
@@ -57,26 +66,70 @@ import Text.XML.HXT.XPath (getXPathTrees)
5766data HostedService = HostedService {
5867 hostedServiceName :: String
5968 }
60− deriving Show
6169
6270data CloudService = CloudService {
6371 cloudServiceName :: String
6472 , cloudServiceVMs :: [VirtualMachine]
6573 }
66− deriving Show
6774
6875data VirtualMachine = VirtualMachine {
6976 vmName :: String
7077 , vmInputEndpoints :: [Endpoint]
7178 }
72− deriving Show
7379
7480data Endpoint = Endpoint {
75− endpointName :: String
76− , endpointPort :: String
77− , endpointVip :: String
78− }
79− deriving Show
81+ endpointName :: String
82+ , endpointPort :: String
83+ , endpointVip :: String
84+ }
85+
86+--------------------------------------------------------------------------------
87+-- Pretty-printing --
88+--------------------------------------------------------------------------------
89+
90+instance Show HostedService where
91+ show = show . ppHostedService
92+
93+instance Show CloudService where
94+ show = show . ppCloudService
95+
96+instance Show VirtualMachine where
97+ show = show . ppVirtualMachine
98+
99+instance Show Endpoint where
100+ show = show . ppEndpoint
101+
102+ppHostedService :: HostedService -> Doc
103+ppHostedService = text . hostedServiceName
104+
105+ppCloudService :: CloudService -> Doc
106+ppCloudService cs =
107+ (text "Cloud Service" <+> (doubleQuotes . text . cloudServiceName $ cs))
108+ `hang2`
109+ ( text "VIRTUAL MACHINES"
110+ `hang2`
111+ (vcat . map ppVirtualMachine . cloudServiceVMs $ cs)
112+ )
113+
114+ppVirtualMachine :: VirtualMachine -> Doc
115+ppVirtualMachine vm =
116+ (text "Virtual Machine" <+> (doubleQuotes . text . vmName $ vm))
117+ `hang2`
118+ ( text "INPUT ENDPOINTS"
119+ `hang2`
120+ (vcat . map ppEndpoint . vmInputEndpoints $ vm)
121+ )
122+
123+ppEndpoint :: Endpoint -> Doc
124+ppEndpoint ep =
125+ (text "Input endpoint" <+> (doubleQuotes . text . endpointName $ ep))
126+ `hang2`
127+ ( text "Port" <+> text (endpointPort ep)
128+ $$ text "IP" <+> text (endpointVip ep)
129+ )
130+
131+hang2 :: Doc -> Doc -> Doc
132+hang2 d1 d2 = hang d1 2 d2
80133
81134--------------------------------------------------------------------------------
82135-- Pure operations --