root / src / Ganeti / THH / PyType.hs @ 2992f2f7
History | View | Annotate | Download (3.9 kB)
1 | 6897a51e | Petr Pudlak | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | 6897a51e | Petr Pudlak | |
3 | 6897a51e | Petr Pudlak | {-| PyType helper for Ganeti Haskell code. |
4 | 6897a51e | Petr Pudlak | |
5 | 6897a51e | Petr Pudlak | -} |
6 | 6897a51e | Petr Pudlak | |
7 | 6897a51e | Petr Pudlak | {- |
8 | 6897a51e | Petr Pudlak | |
9 | 6897a51e | Petr Pudlak | Copyright (C) 2013 Google Inc. |
10 | 6897a51e | Petr Pudlak | |
11 | 6897a51e | Petr Pudlak | This program is free software; you can redistribute it and/or modify |
12 | 6897a51e | Petr Pudlak | it under the terms of the GNU General Public License as published by |
13 | 6897a51e | Petr Pudlak | the Free Software Foundation; either version 2 of the License, or |
14 | 6897a51e | Petr Pudlak | (at your option) any later version. |
15 | 6897a51e | Petr Pudlak | |
16 | 6897a51e | Petr Pudlak | This program is distributed in the hope that it will be useful, but |
17 | 6897a51e | Petr Pudlak | WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | 6897a51e | Petr Pudlak | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 | 6897a51e | Petr Pudlak | General Public License for more details. |
20 | 6897a51e | Petr Pudlak | |
21 | 6897a51e | Petr Pudlak | You should have received a copy of the GNU General Public License |
22 | 6897a51e | Petr Pudlak | along with this program; if not, write to the Free Software |
23 | 6897a51e | Petr Pudlak | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 | 6897a51e | Petr Pudlak | 02110-1301, USA. |
25 | 6897a51e | Petr Pudlak | |
26 | 6897a51e | Petr Pudlak | -} |
27 | 6897a51e | Petr Pudlak | module Ganeti.THH.PyType |
28 | 6897a51e | Petr Pudlak | ( PyType(..) |
29 | 6897a51e | Petr Pudlak | , pyType |
30 | 6897a51e | Petr Pudlak | , pyOptionalType |
31 | 6897a51e | Petr Pudlak | ) where |
32 | 6897a51e | Petr Pudlak | |
33 | 6897a51e | Petr Pudlak | import Control.Applicative |
34 | 6897a51e | Petr Pudlak | import Control.Monad |
35 | 6897a51e | Petr Pudlak | import Data.List (intercalate) |
36 | 6897a51e | Petr Pudlak | import Language.Haskell.TH |
37 | 6897a51e | Petr Pudlak | import Language.Haskell.TH.Syntax (Lift(..)) |
38 | 6897a51e | Petr Pudlak | |
39 | 6897a51e | Petr Pudlak | import Ganeti.PyValue |
40 | 6897a51e | Petr Pudlak | |
41 | 6897a51e | Petr Pudlak | |
42 | 6897a51e | Petr Pudlak | -- | Represents a Python encoding of types. |
43 | 6897a51e | Petr Pudlak | data PyType |
44 | 6897a51e | Petr Pudlak | = PTMaybe PyType |
45 | 6897a51e | Petr Pudlak | | PTApp PyType [PyType] |
46 | 6897a51e | Petr Pudlak | | PTOther String |
47 | 6897a51e | Petr Pudlak | | PTAny |
48 | 6897a51e | Petr Pudlak | | PTDictOf |
49 | 6897a51e | Petr Pudlak | | PTListOf |
50 | 6897a51e | Petr Pudlak | | PTNone |
51 | 6897a51e | Petr Pudlak | | PTObject |
52 | 6897a51e | Petr Pudlak | | PTOr |
53 | 6897a51e | Petr Pudlak | | PTSetOf |
54 | 6897a51e | Petr Pudlak | | PTTupleOf |
55 | 6897a51e | Petr Pudlak | deriving (Show, Eq, Ord) |
56 | 6897a51e | Petr Pudlak | |
57 | 6897a51e | Petr Pudlak | -- TODO: We could use th-lift to generate this instance automatically. |
58 | 6897a51e | Petr Pudlak | instance Lift PyType where |
59 | 6897a51e | Petr Pudlak | lift (PTMaybe x) = [| PTMaybe x |] |
60 | 6897a51e | Petr Pudlak | lift (PTApp tf as) = [| PTApp tf as |] |
61 | 6897a51e | Petr Pudlak | lift (PTOther i) = [| PTOther i |] |
62 | 6897a51e | Petr Pudlak | lift PTAny = [| PTAny |] |
63 | 6897a51e | Petr Pudlak | lift PTDictOf = [| PTDictOf |] |
64 | 6897a51e | Petr Pudlak | lift PTListOf = [| PTListOf |] |
65 | 6897a51e | Petr Pudlak | lift PTNone = [| PTNone |] |
66 | 6897a51e | Petr Pudlak | lift PTObject = [| PTObject |] |
67 | 6897a51e | Petr Pudlak | lift PTOr = [| PTOr |] |
68 | 6897a51e | Petr Pudlak | lift PTSetOf = [| PTSetOf |] |
69 | 6897a51e | Petr Pudlak | lift PTTupleOf = [| PTTupleOf |] |
70 | 6897a51e | Petr Pudlak | |
71 | 6897a51e | Petr Pudlak | instance PyValue PyType where |
72 | 6897a51e | Petr Pudlak | showValue (PTMaybe x) = ptApp (ht "Maybe") [x] |
73 | 6897a51e | Petr Pudlak | showValue (PTApp tf as) = ptApp (showValue tf) as |
74 | 6897a51e | Petr Pudlak | showValue (PTOther i) = ht i |
75 | 6897a51e | Petr Pudlak | showValue PTAny = ht "Any" |
76 | 6897a51e | Petr Pudlak | showValue PTDictOf = ht "DictOf" |
77 | 6897a51e | Petr Pudlak | showValue PTListOf = ht "ListOf" |
78 | 6897a51e | Petr Pudlak | showValue PTNone = ht "None" |
79 | 6897a51e | Petr Pudlak | showValue PTObject = ht "Object" |
80 | 6897a51e | Petr Pudlak | showValue PTOr = ht "Or" |
81 | 6897a51e | Petr Pudlak | showValue PTSetOf = ht "SetOf" |
82 | 6897a51e | Petr Pudlak | showValue PTTupleOf = ht "TupleOf" |
83 | 6897a51e | Petr Pudlak | |
84 | 6897a51e | Petr Pudlak | ht :: String -> String |
85 | 6897a51e | Petr Pudlak | ht = ("ht.T" ++) |
86 | 6897a51e | Petr Pudlak | |
87 | 6897a51e | Petr Pudlak | ptApp :: String -> [PyType] -> String |
88 | 6897a51e | Petr Pudlak | ptApp name ts = name ++ "(" ++ intercalate ", " (map showValue ts) ++ ")" |
89 | 6897a51e | Petr Pudlak | |
90 | 6897a51e | Petr Pudlak | -- | Converts a Haskell type name into a Python type name. |
91 | 6897a51e | Petr Pudlak | pyTypeName :: Name -> PyType |
92 | 6897a51e | Petr Pudlak | pyTypeName name = |
93 | 6897a51e | Petr Pudlak | case nameBase name of |
94 | 6897a51e | Petr Pudlak | "()" -> PTNone |
95 | 6897a51e | Petr Pudlak | "Map" -> PTDictOf |
96 | 6897a51e | Petr Pudlak | "Set" -> PTSetOf |
97 | 6897a51e | Petr Pudlak | "ListSet" -> PTSetOf |
98 | 6897a51e | Petr Pudlak | "Either" -> PTOr |
99 | 6897a51e | Petr Pudlak | "GenericContainer" -> PTDictOf |
100 | 6897a51e | Petr Pudlak | "JSValue" -> PTAny |
101 | 6897a51e | Petr Pudlak | "JSObject" -> PTObject |
102 | 6897a51e | Petr Pudlak | str -> PTOther str |
103 | 6897a51e | Petr Pudlak | |
104 | 6897a51e | Petr Pudlak | -- | Converts a Haskell type into a Python type. |
105 | 6897a51e | Petr Pudlak | pyType :: Type -> Q PyType |
106 | 6897a51e | Petr Pudlak | pyType t | not (null args) = PTApp `liftM` pyType fn `ap` mapM pyType args |
107 | 6897a51e | Petr Pudlak | where (fn, args) = pyAppType t |
108 | 6897a51e | Petr Pudlak | pyType (ConT name) = return $ pyTypeName name |
109 | 6897a51e | Petr Pudlak | pyType ListT = return PTListOf |
110 | 6897a51e | Petr Pudlak | pyType (TupleT 0) = return PTNone |
111 | 6897a51e | Petr Pudlak | pyType (TupleT _) = return PTTupleOf |
112 | 6897a51e | Petr Pudlak | pyType typ = fail $ "unhandled case for type " ++ show typ |
113 | 6897a51e | Petr Pudlak | |
114 | 6897a51e | Petr Pudlak | -- | Returns a type and its type arguments. |
115 | 6897a51e | Petr Pudlak | pyAppType :: Type -> (Type, [Type]) |
116 | 6897a51e | Petr Pudlak | pyAppType = g [] |
117 | 6897a51e | Petr Pudlak | where |
118 | 6897a51e | Petr Pudlak | g as (AppT typ1 typ2) = g (typ2 : as) typ1 |
119 | 6897a51e | Petr Pudlak | g as typ = (typ, as) |
120 | 6897a51e | Petr Pudlak | |
121 | 6897a51e | Petr Pudlak | -- | @pyType opt typ@ converts Haskell type @typ@ into a Python type, |
122 | 6897a51e | Petr Pudlak | -- where @opt@ determines if the converted type is optional (i.e., |
123 | 6897a51e | Petr Pudlak | -- Maybe). |
124 | 6897a51e | Petr Pudlak | pyOptionalType :: Bool -> Type -> Q PyType |
125 | 6897a51e | Petr Pudlak | pyOptionalType True typ = PTMaybe <$> pyType typ |
126 | 6897a51e | Petr Pudlak | pyOptionalType False typ = pyType typ |