content: {-# LANGUAGE QuasiQuotes #-}
  
  module Stratosphere.Generator.Main (main) where
  
  import Control.Monad (when)
  import Data.Set (Set)
  import Data.String (fromString)
  import Stratosphere.Generator.Module
  import Stratosphere.Generator.Prelude
  import Stratosphere.Generator.Declaration
  import System.Directory
  import System.FilePath.Posix
  import Text.Shakespeare.Text (st)
  
  import qualified Data.Map                   as Map
  import qualified Data.Set                   as Set
  import qualified Data.Text                  as Text
  import qualified Data.Text.IO               as Text
  import qualified Data.Version               as Version
  import qualified GHC.SourceGen              as GHC
  import qualified Hpack
  import qualified Paths_stratosphere         as Stratosphere
  import qualified Stratosphere.Generator.Raw as Raw
  
  main :: IO ()
  main = do
    rawSpec <- either error id <$> Raw.readSpec ("generator" </> "model" </> "CloudFormationResourceSpecification.json")
  
    removeDirectoryIfExists "services"
    removeDirectoryIfExists "gen"
  
    generate rawSpec
    where
      removeDirectoryIfExists name = do
        exists <- doesDirectoryExist name
        when exists $ removeDirectoryRecursive name
  
  generate :: Raw.Spec -> IO ()
  generate Raw.Spec{..} = do
    traverse_ (uncurry writeResourceTypeModule) $ Map.toList specResourceTypes
    traverse_ (uncurry writePropertyTypeModule) $ Map.toList specPropertyTypes
    traverse_ writePackage services
    where
      services = Set.toList . Set.fromList $ (.service) <$> Map.keys specResourceTypes
  
  writePackage :: Raw.Service -> IO ()
  writePackage service = do
    Text.putStrLn $ "Writing: " <> Text.pack packageFileName
    Text.writeFile packageFileName [st|# Generated by stratosphere-gen
  
  _common/package: !include "../../common/package.yaml"
  
  name: #{packageName}
  version: #{version}
  library:
    source-dirs: gen
  
    ghc-options:
    - -Wno-unused-imports
  <<: *defaults
  
  dependencies:
  - aeson
  - base
  - stratosphere == #{version}
  |]
    withCurrentDirectory directory $ Hpack.hpack Hpack.NoVerbose Hpack.defaultOptions
    where
      directory       = serviceDirectory service
      packageFileName = directory </> "package.yaml"
      packageName     = "stratosphere-" <> packageSlug service
      version         = Version.showVersion Stratosphere.version
  
  moduleFileName :: GHC.ModuleNameStr -> FilePath
  moduleFileName moduleName = go "gen" (Text.unpack <$> components)
    where
      go :: FilePath -> [String] -> FilePath
      go _acc [] = error "Empty module Name?"
      go acc [file] = acc </> (file <.> ".hs")
      go acc (next:reminder) = go (acc </> next) reminder
  
      components = Text.split (== '.') $ Text.pack $ GHC.moduleNameStrToString moduleName
  
  writeResourceTypeModule :: Raw.ResourceTypeName -> Raw.ResourceType -> IO ()
  writeResourceTypeModule resourceTypeName Raw.ResourceType{..} = do
    writeModule moduleFilePath $
      GHC.module'
        (Just moduleName)
        (Just exports)
        (renderImports (pure resourceTypeName) imports)
        declarations
    where
      moduleFilePath = serviceDirectory service </> moduleFileName moduleName
  
      (declarations, State{..})
        = genRecord
          Record
          { awsType     = toText resourceTypeName
          , builderName = "mk" <> recordName
          , name        = recordName
          , properties  = resourceTypeProperties
          , ..
          }
  
      recordName = resourceTypeName.resource
  
      moduleName :: GHC.ModuleNameStr
      moduleName
        = fromString
        . Text.unpack
        $ Text.intercalate "."
        [ "Stratosphere"
        , service.service
        , resourceTypeName.resource
        ]
  
      service :: Raw.Service
      service = resourceTypeName.service
  
  writePropertyTypeModule
    :: HasCallStack
    => Raw.PropertyTypeName
    -> Raw.PropertyType
    -> IO ()
  writePropertyTypeModule propertyTypeName propertyType@Raw.PropertyType{..} = do
    case propertyTypeProperties of
      Nothing -> do
        writeModule moduleFilePath typeAliasModule
        writeModule (moduleFilePath <> "-boot") $ typeAliasModule
      (Just properties) -> do
        writeModule moduleFilePath $ recordModule properties
        writeModule (moduleFilePath <> "-boot") $ recordModuleBoot
    where
      (directory, typeName, resourceTypeName) = case propertyTypeName of
        Raw.Tag -> (".", "Tag", Nothing)
        (Raw.PropertyTypeName resourceTypeName' propertyName) ->
          ( (serviceDirectory $ resourceTypeName'.service)
          , Raw.mkPropertyTypeName propertyName
          , pure resourceTypeName'
          )
  
      moduleFilePath = directory </> moduleFileName moduleName
      moduleName     = propertyTypeModuleName propertyTypeName
  
      typeAliasModule :: HasCallStack => GHC.HsModule'
      typeAliasModule =
        GHC.module'
          (Just moduleName)
          (Just exports)
          (renderImports resourceTypeName imports)
          [typeAlias]
          where
            (typeAlias, State{..}) = genTypeAlias propertyTypeName propertyType
  
      recordModule properties =
        GHC.module'
          (Just moduleName)
          (Just exports)
          (renderImports resourceTypeName imports)
          declarations
          where
            (declarations, State{..})
              = genRecord
                Record
                { awsType     = toText propertyTypeName
                , builderName = "mk" <> typeName
                , name        = typeName
                , ..
                }
  
      recordModuleBoot =
        GHC.module'
          (Just moduleName)
          Nothing
          (renderImports resourceTypeName imports)
          declarations
          where
            (declarations, State{..})
              = genRecordBoot
                Record
                { awsType     = toText propertyTypeName
                , builderName = "mk" <> typeName
                , name        = typeName
                , properties  = []
                }
  
  renderImports :: Maybe Raw.ResourceTypeName -> Set Import -> [GHC.ImportDecl']
  renderImports resourceTypeName = fmap mkImport . Set.toList
    where
      mkImport = \case
        JSON                     -> GHC.qualified' $ GHC.import' "Data.Aeson" `GHC.as'` "JSON"
        Prelude                  -> GHC.qualified' $ GHC.import' "Stratosphere.Prelude" `GHC.as'` "Prelude"
        Property                 -> GHC.import' "Stratosphere.Property"
        ResourceProperties       -> GHC.import' "Stratosphere.ResourceProperties"
        Tag                      -> GHC.import' "Stratosphere.Tag"
        Value                    -> GHC.import' "Stratosphere.Value"
        (Reference propertyName) ->
          case resourceTypeName of
            (Just resourceTypeName') ->
               GHC.source $ GHC.import' (resourceTypePropertyModuleName resourceTypeName' propertyName) `GHC.as'` "Exports"
            Nothing -> error $ "Unresolved reference to: " <> show propertyName
  
  packageSlug :: Raw.Service -> Text
  packageSlug service = Text.toLower (getField @"service" service)
  
  serviceDirectory :: Raw.Service -> FilePath
  serviceDirectory service = "services" </> Text.unpack (packageSlug service)
  
  propertyTypeModuleName :: Raw.PropertyTypeName -> GHC.ModuleNameStr
  propertyTypeModuleName = \case
    Raw.Tag -> tagModuleName
    (Raw.PropertyTypeName resourceTypeName propertyName) -> resourceTypePropertyModuleName resourceTypeName propertyName
  
  tagModuleName :: GHC.ModuleNameStr
  tagModuleName = "Stratosphere.Tag"
  
  resourceTypePropertyModuleName :: Raw.ResourceTypeName -> Raw.PropertyName -> GHC.ModuleNameStr
  resourceTypePropertyModuleName resourceTypeName propertyName
    = fromString
    . Text.unpack
    $ Text.intercalate "."
    [ "Stratosphere"
    , getField @"service" (getField @"service" resourceTypeName)
    , getField @"resource" resourceTypeName
    , Raw.toText propertyName <> "Property"
    ]
  