{-# LANGUAGE CPP               #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Wrappers for generating prologue and epilogue code in Haskell.
module Data.Aeson.AutoType.CodeGen.Haskell(
    writeHaskellModule
  , runHaskellModule
  , runHaskellModuleStrict
  , defaultHaskellFilename
  , importedModules
  , requiredPackages
  , generateModuleImports
  ) where

import qualified Data.Text           as Text
import qualified Data.Text.IO        as Text
import           Data.Text hiding (unwords)
import qualified Data.HashMap.Strict as Map
import           Control.Arrow               (first)
import           Control.Exception (assert)
import           Data.Default
import           Data.Monoid                 ((<>))
import           System.FilePath
import           System.IO
import           System.Process                 (system)
import qualified System.Environment             (lookupEnv)
import           System.Exit                    (ExitCode)

import           Data.Aeson.AutoType.Format
import           Data.Aeson.AutoType.Type
import           Data.Aeson.AutoType.CodeGen.Generic(src)
import           Data.Aeson.AutoType.CodeGen.HaskellFormat
import           Data.Aeson.AutoType.Util

import qualified Language.Haskell.RunHaskellModule as Run

-- | Default output filname is used, when there is no explicit output file path, or it is "-" (stdout).
-- Default module name is consistent with it.
defaultHaskellFilename :: FilePath
defaultHaskellFilename :: FilePath
defaultHaskellFilename = "JSONTypes.hs"

header :: Text -> Text
header :: Text -> Text
header moduleName :: Text
moduleName = [src|
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE DeriveGeneric       #-}
-- | DO NOT EDIT THIS FILE MANUALLY!
--   It was automatically generated by `json-autotype`.

module |] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
capitalize Text
moduleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [src| where
|] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
generateModuleImports [Text]
importedModules

type ModuleImport = Text

generateModuleImports :: [ModuleImport] -> Text
generateModuleImports :: [Text] -> Text
generateModuleImports  = [Text] -> Text
Text.unlines
                       ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

-- | List of packages required by modules below.
--   Keep and maintain together.
requiredPackages :: [Text]
requiredPackages :: [Text]
requiredPackages = ["aeson", "json-alt", "base", "bytestring", "text"]

-- | List of modules to import
importedModules :: [ModuleImport]
importedModules :: [Text]
importedModules = [
    "          System.Exit        (exitFailure, exitSuccess)"
  , "          System.IO          (stderr, hPutStrLn)"
  , "qualified Data.ByteString.Lazy.Char8 as BSL"
  , "          System.Environment (getArgs)"
  , "          Control.Monad      (forM_, mzero, join)"
  , "          Control.Applicative"
  , "          Data.Aeson.AutoType.Alternative"
  , "          Data.Aeson(eitherDecode, Value(..), FromJSON(..), ToJSON(..),pairs,(.:), (.:?), (.=), object)"
  , "          Data.Monoid((<>))"
  , "          Data.Text (Text)"
  , "qualified GHC.Generics"
  ]

epilogue :: Text -> Text
epilogue :: Text -> Text
epilogue toplevelName :: Text
toplevelName = [src|
parse :: FilePath -> IO |] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
toplevelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [src|
parse filename = do
    input <- BSL.readFile filename
    case eitherDecode input of
      Left errTop -> fatal $ case (eitherDecode input :: Either String Value) of
                           Left  err -> "Invalid JSON file: " ++ filename ++ "\n   " ++ err
                           Right _   -> "Mismatched JSON value from file: " ++ filename
                                     ++ "\n" ++ errTop
      Right r     -> return (r :: |] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
toplevelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [src|
  where
    fatal :: String -> IO a
    fatal msg = do hPutStrLn stderr msg
                   exitFailure

main :: IO ()
main = do
  filenames <- getArgs
  forM_ filenames (\f -> parse f >>= (\p -> p `seq` putStrLn $ "Successfully parsed " ++ f))
  exitSuccess
|]

-- | Write a Haskell module to an output file, or stdout if `-` filename is given.
writeHaskellModule :: FilePath -> Text -> Map.HashMap Text Type -> IO ()
writeHaskellModule :: FilePath -> Text -> HashMap Text Type -> IO ()
writeHaskellModule outputFilename :: FilePath
outputFilename toplevelName :: Text
toplevelName types :: HashMap Text Type
types =
    FilePath -> IOMode -> Handle -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> Handle -> (Handle -> IO r) -> IO r
withFileOrHandle FilePath
outputFilename IOMode
WriteMode Handle
stdout ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \hOut :: Handle
hOut ->
      Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (FilePath
extension FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".hs") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> Text -> IO ()
Text.hPutStrLn Handle
hOut (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
header (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
moduleName
        -- We write types as Haskell type declarations to output handle
        Handle -> Text -> IO ()
Text.hPutStrLn Handle
hOut (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ HashMap Text Type -> Text
displaySplitTypes HashMap Text Type
types
        Handle -> Text -> IO ()
Text.hPutStrLn Handle
hOut (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
epilogue Text
toplevelName
  where
    (moduleName :: FilePath
moduleName, extension :: FilePath
extension) =
       (FilePath -> FilePath)
-> (FilePath, FilePath) -> (FilePath, FilePath)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first FilePath -> FilePath
normalizeTypeName'     ((FilePath, FilePath) -> (FilePath, FilePath))
-> (FilePath, FilePath) -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$
       FilePath -> (FilePath, FilePath)
splitExtension               (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$
       if     FilePath
outputFilename FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "-"
         then FilePath
defaultHaskellFilename
         else FilePath
outputFilename
    normalizeTypeName' :: FilePath -> FilePath
normalizeTypeName' = Text -> FilePath
Text.unpack (Text -> FilePath) -> (FilePath -> Text) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeTypeName (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack

runHaskellModule :: FilePath -> [String] -> IO ExitCode
runHaskellModule :: FilePath -> [FilePath] -> IO ExitCode
runHaskellModule = FilePath -> [FilePath] -> IO ExitCode
Run.runHaskellModule

defaultHaskellOpts :: Run.RunOptions
defaultHaskellOpts :: RunOptions
defaultHaskellOpts  = RunOptions
forall a. Default a => a
def { additionalPackages :: [FilePath]
Run.additionalPackages = ["json-alt", "aeson"]
                          }

runHaskellModuleStrict :: FilePath -> [String] -> IO ExitCode
runHaskellModuleStrict :: FilePath -> [FilePath] -> IO ExitCode
runHaskellModuleStrict = RunOptions -> FilePath -> [FilePath] -> IO ExitCode
Run.runHaskellModule' RunOptions
opts
  where
      opts :: RunOptions
opts = RunOptions
forall a. Default a => a
def { compileArgs :: [FilePath]
Run.compileArgs = ["-Wall", "-Werror"]}