{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Wrappers for generating prologue and epilogue code in Haskell.
module Data.Aeson.AutoType.CodeGen.Elm(
    defaultElmFilename
  , writeElmModule
  , runElmModule
  ) where

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

import           Data.Aeson.AutoType.Format
import           Data.Aeson.AutoType.Type
import           Data.Aeson.AutoType.Util
import           Data.Aeson.AutoType.CodeGen.ElmFormat

import Debug.Trace(trace)

defaultElmFilename :: FilePath
defaultElmFilename = "JSONTypes.elm"

header :: Text -> Text
header :: Text -> Text
header moduleName :: Text
moduleName = [Text] -> Text
Text.unlines [
   [Text] -> Text
Text.unwords ["module ", Text -> Text
capitalize Text
moduleName, " exposing(..)"]
  ,""
  ,"-- DO NOT EDIT THIS FILE MANUALLY!"
  ,"-- It was automatically generated by `json-autotype`."
  ,"-- elm-package install toastal/either"
  ,"-- elm-package install NoRedInk/elm-decode-pipeline"
  ,"import Either               exposing (Either, unpack)"
  ,"import Json.Encode          exposing (..)"
  ,"import Json.Decode          exposing (..)"
  ,"import Json.Decode.Pipeline exposing (..)"
  ,""]

epilogue :: Text -> Text
epilogue :: Text -> Text
epilogue toplevelName :: Text
toplevelName = [Text] -> Text
Text.unlines []

-- | Write a Haskell module to an output file, or stdout if `-` filename is given.
writeElmModule :: FilePath -> Text -> Map.HashMap Text Type -> IO ()
writeElmModule :: FilePath -> Text -> HashMap Text Type -> IO ()
writeElmModule 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 -> FilePath -> FilePath
forall a. FilePath -> a -> a
trace FilePath
extension FilePath
extension FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".elm") (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
defaultElmFilename
         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

runElmModule :: FilePath -> [String] -> IO ExitCode
runElmModule :: FilePath -> [FilePath] -> IO ExitCode
runElmModule elmModule :: FilePath
elmModule _arguments :: [FilePath]
_arguments = do
    Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr "Compiling *not* running Elm module for a test."
    FilePath -> IO ExitCode
system (FilePath -> IO ExitCode) -> FilePath -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
Prelude.unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ["elm", "make", FilePath
elmModule] -- ignore parsing args