{-# LANGUAGE OverloadedStrings   #-}

module Main where

import Data.Foldable (for_)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Map as Map
import qualified System.FilePath as FP
import qualified System.Directory as Dir
import qualified System.IO as IO

import qualified CDP.Definition as D
import qualified CDP.Gen.Program as GP
import CDP.Gen.Deprecated (removeDeprecated)

main :: IO ()
main :: IO ()
main = do
    [Domain]
domains <- ([[Domain]] -> [Domain]) -> IO [[Domain]] -> IO [Domain]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Domain]] -> [Domain]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[Domain]] -> IO [Domain])
-> ([FilePath] -> IO [[Domain]]) -> [FilePath] -> IO [Domain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> IO [Domain]) -> [FilePath] -> IO [[Domain]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((TopLevel -> [Domain]) -> IO TopLevel -> IO [Domain]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TopLevel -> [Domain]
D.topLevelDomains (IO TopLevel -> IO [Domain])
-> (FilePath -> IO TopLevel) -> FilePath -> IO [Domain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TopLevel -> TopLevel) -> IO TopLevel -> IO TopLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TopLevel -> TopLevel
removeDeprecated (IO TopLevel -> IO TopLevel)
-> (FilePath -> IO TopLevel) -> FilePath -> IO TopLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO TopLevel
D.parse) ([FilePath] -> IO [Domain]) -> [FilePath] -> IO [Domain]
forall a b. (a -> b) -> a -> b
$
        [ FilePath
browserDefinitionPath
        , FilePath
jsDefinitionPath 
        ] 

    let program :: Program
program = [Domain] -> Program
GP.genProgram [Domain]
domains

    [(ComponentName, Text)]
-> ((ComponentName, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map ComponentName Text -> [(ComponentName, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ComponentName Text -> [(ComponentName, Text)])
-> (Program -> Map ComponentName Text)
-> Program
-> [(ComponentName, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Map ComponentName Text
GP.pComponents (Program -> [(ComponentName, Text)])
-> Program -> [(ComponentName, Text)]
forall a b. (a -> b) -> a -> b
$ Program
program) (((ComponentName, Text) -> IO ()) -> IO ())
-> ((ComponentName, Text) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ComponentName
dn,Text
d) -> do
        let path :: FilePath
path = FilePath -> FilePath
domainPath (FilePath -> FilePath)
-> (ComponentName -> FilePath) -> ComponentName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> (ComponentName -> Text) -> ComponentName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> Text
GP.unComponentName (ComponentName -> FilePath) -> ComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ComponentName
dn
        Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing domain to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"..."
        FilePath -> Text -> IO ()
T.writeFile FilePath
path Text
d

    let protocol :: Text
protocol = [ComponentName] -> Text -> Text
GP.genProtocolModule (Map ComponentName Text -> [ComponentName]
forall k a. Map k a -> [k]
Map.keys (Map ComponentName Text -> [ComponentName])
-> (Program -> Map ComponentName Text)
-> Program
-> [ComponentName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Map ComponentName Text
GP.pComponents (Program -> [ComponentName]) -> Program -> [ComponentName]
forall a b. (a -> b) -> a -> b
$ Program
program) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
          Program -> Text
GP.pComponentImports Program
program

    Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing protocol to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
protocolModulePath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"..."
    FilePath -> Text -> IO ()
T.writeFile FilePath
protocolModulePath Text
protocol
  where
    domainPath :: FilePath -> FilePath
domainPath FilePath
dn         = FilePath
domainDir FilePath -> FilePath -> FilePath
FP.</> FilePath -> FilePath -> FilePath
FP.addExtension FilePath
dn FilePath
"hs"
    domainDir :: FilePath
domainDir             = FilePath
"src/CDP/Domains"
    protocolModulePath :: FilePath
protocolModulePath    = FilePath
"src/CDP/Domains.hs"
    jsDefinitionPath :: FilePath
jsDefinitionPath       = FilePath
"devtools-protocol/json/js_protocol.json"
    browserDefinitionPath :: FilePath
browserDefinitionPath  = FilePath
"devtools-protocol/json/browser_protocol.json"