/dhall-aws-cloudformation/gh-pages/app/Main.hs.html
Copy path to clipboardSource
<!DOCTYPE HTML><html><head><title>/app/Main.hs</title><link rel="stylesheet" type="text/css" href="../index.css"><link rel="stylesheet" type="text/css" href="https://fonts.googleapis.com/css2?family=Fira+Code:wght@400;500;600;700&family=Lato:ital,wght@0,400;0,700;1,400&display=swap"><script type="text/javascript" src="../index.js"></script><meta charset="UTF-8"></head><body><div class="nav-bar"><img class="dhall-icon" src="../dhall-icon.svg"><p class="package-title">dhall-aws-cloudformation</p><div class="nav-bar-content-divider"></div><a id="switch-light-dark-mode" class="nav-option">Switch Light/Dark Mode</a></div><div class="main-container"><h2 class="doc-title"><span class="crumb-divider">/</span><a href="../index.html">dhall-aws-cloudformation</a><span class="crumb-divider">/</span><a class="title-crumb" href="index.html">app</a><span class="crumb-divider">/</span><span class="title-crumb" href="index.html">Main.hs</span></h2><a class="copy-to-clipboard" data-path="https://raw.githubusercontent.com/jcouyang/dhall-aws-cloudformation/0.9.81/app/Main.hs"><i><small>Copy path to clipboard</small></i></a><br><h3>Source</h3><div class="source-code">{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad.Error.Class (MonadError (throwError), liftEither)
import Data.Aeson (eitherDecode)
import Data.ByteString.Builder (toLazyByteString)
import Data.Foldable (traverse_)
import Data.Map (Map, size, toList)
import Data.Text (Text, unpack)
import Data.Text.Lazy (pack)
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Encoding (encodeUtf8)
import qualified Data.Text.Lazy.IO as TIO
import Dhall (Decoder, FromDhall, auto, field,
input, inputFile, record, string)
import Dhall.Cloudformation (DhallExpr,
Spec (resourceSpecificationVersion),
convertSpec)
import qualified Dhall.Core as Dhall
import qualified Dhall.Pretty
import Dhall.Sam.Template (parseTemplates)
import GHC.Generics (Generic)
import qualified Prettyprinter.Render.Text as Pretty.Text
import System.Directory (createDirectoryIfMissing)
import System.FilePath.Posix (takeDirectory, (</>))
data Config = Config
{specifications :: Map Text Text
,excludes :: [Text]
,templates :: Map Text Text
} deriving stock (Show)
readConfig :: Decoder Config
readConfig =
record
( Config <$> field "specifications" auto
<*> field "excludes" auto
<*> field "templates" auto
)
main :: IO ()
main = do
config <- inputFile readConfig "./config.dhall" :: IO Config
traverse_ (genRegionSpec (excludes config)) $ toList (specifications config)
traverse_ genTemplate $ toList (templates config)
where
genRegionSpec :: [Text] -> (Text, Text) -> IO ()
genRegionSpec excl (region, url) = do
spec <- input string (url <> " as Text")
case convert spec excl of
Left e -> putStr e
Right (v, s) -> traverse_ (genFile v region) (toList s)
genTemplate (name, url) = do
template <- input auto (url <> " as Text")
case (eitherDecode . encodeUtf8) template of
Left e -> do
putStr e
Right maps -> traverse_ (genFile "" name) (toList $ prettyPrint <$> parseTemplates maps)
convert :: String -> [Text] -> Either String (Text, Map Text Lazy.Text)
convert spec excl= versioned excl <$> (decodeSpec spec :: Either String Spec)
versioned excl s = (resourceSpecificationVersion s, (fmap prettyPrint . convertSpec excl) s)
decodeSpec = eitherDecode . encodeUtf8 . pack
genFile _ region (k, v) = mkFile (unpack region) (unpack k) v
prettyPrint :: DhallExpr -> Lazy.Text
prettyPrint expr = Pretty.Text.renderLazy stream
where
stream = Dhall.Pretty.layout $ Dhall.Pretty.prettyCharacterSet Dhall.Pretty.ASCII expr
mkFile :: String -> FilePath -> Lazy.Text -> IO ()
mkFile prefix path content = do
let d = prefix </> path <> ".dhall"
createDirectoryIfMissing True $ takeDirectory d
TIO.writeFile d content
</div></div></body></html>