git.iko.soy/distributed-process
on master help sign in
Prettier output
e06c6bfEdsko de Vries
azure-service-api/azure-service-api.cabal+1
compare with master
unifiedsplit
@@ -25,6 +25,7 @@ Library
25 certificate >= 1.2 && < 1.3,
25 certificate >= 1.2 && < 1.3,
26 case-insensitive >= 0.4 && < 0.5,
26 case-insensitive >= 0.4 && < 0.5,
27 hxt >= 9.2 && < 9.3,
27 hxt >= 9.2 && < 9.3,
28+ pretty >= 1.1 && < 1.2,
28 resourcet,
29 resourcet,
29 transformers,
30 transformers,
30 hxt-xpath
31 hxt-xpath
azure-service-api/src/Network/Azure/ServiceManagement.hs+61−8
@@ -28,6 +28,15 @@ import Data.Certificate.X509 (X509)
28import Control.Monad.Trans.Resource (ResourceT)
28import Control.Monad.Trans.Resource (ResourceT)
29import Control.Monad.IO.Class (liftIO)
29import Control.Monad.IO.Class (liftIO)
30import Control.Arrow.ArrowList (listA)
30import Control.Arrow.ArrowList (listA)
31+import Text.PrettyPrint
32+ ( Doc
33+ , text
34+ , (<+>)
35+ , ($$)
36+ , vcat
37+ , hang
38+ , doubleQuotes
39+ )
31import Network.HTTP.Conduit
40import Network.HTTP.Conduit
32 ( parseUrl
41 ( parseUrl
33 , clientCertificates
42 , clientCertificates
@@ -57,26 +66,70 @@ import Text.XML.HXT.XPath (getXPathTrees)
57data HostedService = HostedService {
66data HostedService = HostedService {
58 hostedServiceName :: String
67 hostedServiceName :: String
59 }
68 }
60− deriving Show
61
69
62data CloudService = CloudService {
70data CloudService = CloudService {
63 cloudServiceName :: String
71 cloudServiceName :: String
64 , cloudServiceVMs :: [VirtualMachine]
72 , cloudServiceVMs :: [VirtualMachine]
65 }
73 }
66− deriving Show
67
74
68data VirtualMachine = VirtualMachine {
75data VirtualMachine = VirtualMachine {
69 vmName :: String
76 vmName :: String
70 , vmInputEndpoints :: [Endpoint]
77 , vmInputEndpoints :: [Endpoint]
71 }
78 }
72− deriving Show
73
79
74data Endpoint = Endpoint {
80data Endpoint = Endpoint {
75− endpointName :: String
81+ endpointName :: String
76− , endpointPort :: String
82+ , endpointPort :: String
77− , endpointVip :: String
83+ , endpointVip :: String
78− }
84+ }
79− deriving Show
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
80
133
81--------------------------------------------------------------------------------
134--------------------------------------------------------------------------------
82-- Pure operations --
135-- Pure operations --
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+1−1
@@ -104,7 +104,7 @@ main = do
104 params <- azureParameters azureOpts Nothing
104 params <- azureParameters azureOpts Nothing
105 backend <- initializeBackend params
105 backend <- initializeBackend params
106 css <- cloudServices backend
106 css <- cloudServices backend
107− print css
107+ mapM_ print css
108 Start azureOpts sshOpts name -> do
108 Start azureOpts sshOpts name -> do
109 params <- azureParameters azureOpts (Just sshOpts)
109 params <- azureParameters azureOpts (Just sshOpts)
110 backend <- initializeBackend params
110 backend <- initializeBackend params