Skip to content

Commit e334ed9

Browse files
timbod7timbod7
committedJan 4, 2017
Initial version
0 parents  commit e334ed9

File tree

9 files changed

+1797
-0
lines changed

9 files changed

+1797
-0
lines changed
 

‎.gitignore

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
.stack-work

‎LICENSE

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright Tim Docker (c) 2017
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of Tim Docker nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎Setup.hs

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

‎scripts/generate.hs

+442
Large diffs are not rendered by default.

‎src/Language/Terraform/Aws.hs

+970
Large diffs are not rendered by default.

‎src/Language/Terraform/Core.hs

+231
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,231 @@
1+
{-# LANGUAGE OverloadedStrings,FlexibleInstances #-}
2+
module Language.Terraform.Core where
3+
4+
import Data.Monoid
5+
import Control.Monad(void)
6+
import Control.Monad.Trans.State.Lazy(StateT,get,put,modify',runStateT)
7+
import System.FilePath((</>))
8+
import Data.Foldable(for_)
9+
import Data.String(IsString(..))
10+
11+
import qualified Data.Map as M
12+
import qualified Data.Set as S
13+
import qualified Data.Text as T
14+
import qualified Data.Text.IO as T
15+
import qualified Language.Terraform.Util.Text as T
16+
17+
type NameElement = T.Text
18+
type Name = [NameElement]
19+
20+
type TFType = T.Text
21+
22+
data Provider = Provider {
23+
p_type :: T.Text,
24+
p_name :: [NameElement],
25+
p_fields :: ResourceFieldMap
26+
}
27+
28+
data Resource = Resource {
29+
r_type :: T.Text,
30+
r_name :: [NameElement],
31+
r_fields :: ResourceFieldMap
32+
}
33+
34+
data Output = Output {
35+
o_name :: [NameElement],
36+
o_value :: T.Text
37+
}
38+
39+
type ResourceFieldMap = M.Map T.Text ResourceField
40+
41+
data ResourceField = RF_Text T.Text
42+
| RF_List [ResourceField]
43+
| RF_Map ResourceFieldMap
44+
45+
class ToResourceField a where
46+
toResourceField :: a -> ResourceField
47+
toResourceFieldList :: [a] -> ResourceField
48+
toResourceFieldList as = RF_List (map toResourceField as)
49+
50+
class ToResourceFieldMap a where
51+
toResourceFieldMap :: a -> ResourceFieldMap
52+
53+
instance IsString ResourceField where
54+
fromString = RF_Text . T.pack
55+
56+
data ResourceId = ResourceId TFType Name
57+
deriving (Eq,Ord)
58+
59+
class IsResource a where
60+
resourceId :: a -> ResourceId
61+
62+
newtype TFRef t = TFRef {
63+
tfRefText :: T.Text
64+
} deriving (Eq)
65+
66+
instance ToResourceField (TFRef t) where
67+
toResourceField (TFRef t) = RF_Text t
68+
69+
instance ToResourceField Int where
70+
toResourceField v = RF_Text (T.pack (show v))
71+
72+
instance ToResourceField T.Text where
73+
toResourceField t = RF_Text t
74+
75+
instance ToResourceField Char where
76+
toResourceField c = RF_Text (T.singleton c)
77+
78+
instance ToResourceField Bool where
79+
toResourceField True = RF_Text "true"
80+
toResourceField False = RF_Text "false"
81+
82+
instance ToResourceField a => ToResourceField [a] where
83+
toResourceField = RF_List . map toResourceField
84+
85+
instance ToResourceField a => ToResourceField (M.Map T.Text a) where
86+
toResourceField = RF_Map . M.map toResourceField
87+
88+
data TFState = TFState {
89+
tf_context :: [NameElement],
90+
tf_providers :: [Provider],
91+
tf_resources :: [Resource],
92+
tf_outputs :: [Output],
93+
tf_dependencies :: S.Set (ResourceId,ResourceId)
94+
}
95+
96+
type TF a = StateT TFState IO a
97+
98+
nameText :: Name -> T.Text
99+
nameText nameElements = T.intercalate "_" (reverse nameElements)
100+
101+
getNameText :: NameElement -> TF T.Text
102+
getNameText name0 = do
103+
context <- tf_context <$> get
104+
return (nameText (name0:context))
105+
106+
-- | Generate the given terraform with a more specific naming context
107+
withNameScope:: NameElement -> TF a -> TF a
108+
withNameScope name tfa = do
109+
s0 <- get
110+
put s0{tf_context=name:tf_context s0}
111+
a <- tfa
112+
s1 <- get
113+
put s1{tf_context=tf_context s0}
114+
return a
115+
116+
mkProvider :: TFType -> [(T.Text,ResourceField)] -> TF ()
117+
mkProvider tftype fields = do
118+
name <- fmap tf_context get
119+
let provider = Provider tftype name (M.fromList fields)
120+
modify' (\s -> s{tf_providers=provider:tf_providers s})
121+
122+
mkResource :: TFType -> NameElement -> ResourceFieldMap -> TF ResourceId
123+
mkResource tftype name0 fieldmap = do
124+
s <- get
125+
let name = name0:tf_context s
126+
let resource = Resource tftype name fieldmap
127+
modify' (\s -> s{tf_resources=resource:tf_resources s})
128+
return (ResourceId tftype name)
129+
130+
resourceAttr :: ResourceId -> T.Text -> TFRef a
131+
resourceAttr (ResourceId tftype name) attr = TFRef (T.template "${$1.$2.$3}" [tftype, nameText name, attr])
132+
133+
output :: NameElement -> T.Text -> TF ()
134+
output name0 value = do
135+
s <- get
136+
let name = name0:tf_context s
137+
let output = Output name value
138+
modify' (\s -> s{tf_outputs=output:tf_outputs s})
139+
140+
dependsOn :: (IsResource r1,IsResource r2) => r1 -> r2 -> TF ()
141+
dependsOn r1 r2 = modify' (\s->s{tf_dependencies=S.insert (resourceId r1, resourceId r2) (tf_dependencies s)})
142+
143+
generateFiles :: FilePath -> TF a -> IO a
144+
generateFiles outDir tfa = do
145+
(a,state) <- runStateT tfa state0
146+
let files = S.fromList [ file | (file:_) <- map (reverse.r_name) (tf_resources state)]
147+
`S.union`
148+
S.fromList [ file | (file:_) <- map (reverse.o_name) (tf_outputs state)]
149+
for_ files $ \file -> do
150+
let content
151+
= [generateProvider state p | p <- reverse (tf_providers state), matchName0 file (p_name p) ]
152+
<> [generateResource state r | r <- reverse (tf_resources state), matchName0 file (r_name r) ]
153+
<> [generateOutput r | r <- reverse (tf_outputs state), matchName0 file (o_name r) ]
154+
T.writeFile (outDir </> T.unpack file <> ".tf") (T.intercalate "\n\n" content)
155+
return a
156+
where
157+
state0 = TFState [] [] [] [] S.empty
158+
matchName0 n ns = case reverse ns of
159+
(n0:_) -> n == n0
160+
_ -> False
161+
162+
generateProvider state p = T.intercalate "\n" (
163+
[ T.template "provider \"$1\" {" [p_type p] ]
164+
<>
165+
generateFieldMap " " (p_fields p)
166+
<>
167+
["}"]
168+
)
169+
170+
generateResource state r = T.intercalate "\n" (
171+
[ T.template "resource \"$1\" \"$2\" {" [r_type r, nameText (r_name r)] ]
172+
<>
173+
generateFieldMap " " fieldMap
174+
<>
175+
["}"]
176+
)
177+
where
178+
fieldMap = M.union (r_fields r) dependsMap
179+
dependsMap | null depends = M.empty
180+
| otherwise = M.singleton "depends_on" (toResourceField [rtype <> "." <> nameText rname | (ResourceId rtype rname) <- depends])
181+
rid = ResourceId (r_type r) (r_name r)
182+
depends = [r2 | (r1,r2) <- S.toList (tf_dependencies state), r1 == rid]
183+
184+
185+
generateFieldMap indent fieldMap = concatMap generateField (M.toList fieldMap)
186+
where
187+
generateField (field,RF_Text value) = [T.template "$1$2 = $3" [indent,field,quotedText value]]
188+
generateField (field,RF_List values)
189+
= [T.template "$1$2 = [" [indent,field]]
190+
<> generateValues (indent <> " ") values
191+
<> [T.template "$1]" [indent]]
192+
generateField (field,RF_Map map)
193+
= [T.template "$1$2 {" [indent,field]]
194+
<> generateFieldMap (indent <> " ") map
195+
<> [T.template "$1}" [indent]]
196+
197+
generateValues indent values = concatMap generateValue (zip values terms)
198+
where
199+
generateValue (RF_Text value,term)
200+
= [T.template "$1\"$2\"$3" [indent,value,term]]
201+
generateValue (RF_List values,term)
202+
= [indent <> "["]
203+
<> generateValues (indent <> " ") values
204+
<> [indent <> "]" <> term]
205+
generateValue (RF_Map map,term)
206+
= [indent <> "{"]
207+
<> generateFieldMap (indent <> " ") map
208+
<> [indent <> "}" <> term]
209+
210+
terms = replicate (length values - 1) "," <> [""]
211+
212+
generateOutput o = T.intercalate "\n"
213+
[ T.template "output \"$1\" {" [nameText (o_name o)]
214+
, T.template " value = \"$1\"" [o_value o]
215+
, "}"
216+
]
217+
218+
quotedText :: T.Text -> T.Text
219+
quotedText value
220+
| needsQuoting value = T.template "<<$1\n$2$3$1"
221+
[uniqueEof value, value, if T.isSuffixOf "\n" value then "" else "\n"]
222+
| otherwise = "\"" <> value <> "\""
223+
224+
needsQuoting :: T.Text -> Bool
225+
needsQuoting value = T.isInfixOf "\n" value || T.isInfixOf "\"" value
226+
227+
uniqueEof :: T.Text -> T.Text
228+
uniqueEof value = head (filter (\eof -> not (T.isInfixOf eof value)) eofs)
229+
where
230+
eofs = ["EOF"] <> ["EOF" <> (T.pack (show n)) | n <- [1,2..]]
231+

‎src/Language/Terraform/Util/Text.hs

+24
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
-- | Helper functions for dealing with text values
2+
module Language.Terraform.Util.Text(
3+
template,
4+
show
5+
) where
6+
7+
import Prelude hiding(show)
8+
9+
import qualified Prelude(show)
10+
import qualified Data.Text as T
11+
12+
13+
show :: (Show a) => a -> T.Text
14+
show = T.pack . Prelude.show
15+
16+
-- | `template src substs` will replace all occurences the string $i
17+
-- in src with `substs !! i`
18+
template :: T.Text -> [T.Text] -> T.Text
19+
template t substs = foldr replace t (zip [1,2..] substs)
20+
where
21+
replace (i,s) t = T.replace (T.pack ('$':Prelude.show i)) s t
22+
23+
24+

‎stack.yaml

+66
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
# This file was automatically generated by 'stack init'
2+
#
3+
# Some commonly used options have been documented as comments in this file.
4+
# For advanced use and comprehensive documentation of the format, please see:
5+
# http://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+
# A snapshot resolver dictates the compiler version and the set of packages
9+
# to be used for project dependencies. For example:
10+
#
11+
# resolver: lts-3.5
12+
# resolver: nightly-2015-09-21
13+
# resolver: ghc-7.10.2
14+
# resolver: ghcjs-0.1.0_ghc-7.10.2
15+
# resolver:
16+
# name: custom-snapshot
17+
# location: "./custom-snapshot.yaml"
18+
resolver: lts-7.14
19+
20+
# User packages to be built.
21+
# Various formats can be used as shown in the example below.
22+
#
23+
# packages:
24+
# - some-directory
25+
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
26+
# - location:
27+
# git: https://github.com/commercialhaskell/stack.git
28+
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
29+
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
30+
# extra-dep: true
31+
# subdirs:
32+
# - auto-update
33+
# - wai
34+
#
35+
# A package marked 'extra-dep: true' will only be built if demanded by a
36+
# non-dependency (i.e. a user package), and its test suites and benchmarks
37+
# will not be run. This is useful for tweaking upstream packages.
38+
packages:
39+
- '.'
40+
# Dependency packages to be pulled from upstream that are not in the resolver
41+
# (e.g., acme-missiles-0.3)
42+
extra-deps: []
43+
44+
# Override default flag values for local packages and extra-deps
45+
flags: {}
46+
47+
# Extra package databases containing global packages
48+
extra-package-dbs: []
49+
50+
# Control whether we use the GHC we find on the path
51+
# system-ghc: true
52+
#
53+
# Require a specific version of stack, using version ranges
54+
# require-stack-version: -any # Default
55+
# require-stack-version: ">=1.1"
56+
#
57+
# Override the architecture used by stack, especially useful on Windows
58+
# arch: i386
59+
# arch: x86_64
60+
#
61+
# Extra directories used by stack for building
62+
# extra-include-dirs: [/path/to/dir]
63+
# extra-lib-dirs: [/path/to/dir]
64+
#
65+
# Allow a newer minor version of GHC than the snapshot specifies
66+
# compiler-check: newer-minor

‎terraform-hs.cabal

+31
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
name: terraform-hs
2+
version: 0.1.0.0
3+
synopsis: Initial project template from stack
4+
description: Please see README.md
5+
homepage: https://github.com/timbod7/terraform-hs#readme
6+
license: BSD3
7+
license-file: LICENSE
8+
author: Tim Docker
9+
maintainer: tim@dockerz.net
10+
copyright: 2017 Tim Docker
11+
category: Web
12+
build-type: Simple
13+
extra-source-files: README.md
14+
cabal-version: >=1.10
15+
16+
library
17+
hs-source-dirs: src
18+
exposed-modules: Language.Terraform.Core
19+
, Language.Terraform.Aws
20+
, Language.Terraform.Util.Text
21+
build-depends: base >= 4.7 && < 5
22+
, containers > 0.5 && < 0.6
23+
, data-default >= 0.5 && < 0.8
24+
, filepath >= 1.4 && < 1.5
25+
, text >= 1.2 && < 1.3
26+
, transformers >= 0.4.2.0 && < 0.6
27+
default-language: Haskell2010
28+
29+
source-repository head
30+
type: git
31+
location: https://github.com/timbod7/terraform-hs

0 commit comments

Comments
 (0)
Please sign in to comment.