{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Wrappers for generating prologue and epilogue code in Haskell.
module JsonToType.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           JsonToType.Format
import           JsonToType.Type
import           JsonToType.Util
import           JsonToType.CodeGen.ElmFormat

import Debug.Trace(trace)

defaultElmFilename :: String
defaultElmFilename = String
"JSONTypes.elm"

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

epilogue :: Text -> Text
epilogue :: Text -> Text
epilogue 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 :: String -> Text -> HashMap Text Type -> IO ()
writeElmModule String
outputFilename Text
toplevelName HashMap Text Type
types =
    String -> IOMode -> Handle -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> Handle -> (Handle -> IO r) -> IO r
withFileOrHandle String
outputFilename IOMode
WriteMode Handle
stdout ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
hOut ->
      Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (String -> String -> String
forall a. String -> a -> a
trace String
extension String
extension String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".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
$ String -> Text
Text.pack String
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
    (String
moduleName, String
extension) =
       (String -> String) -> (String, String) -> (String, String)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> String
normalizeTypeName'     ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$
       String -> (String, String)
splitExtension               (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$
       if     String
outputFilename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-"
         then String
defaultElmFilename
         else String
outputFilename
    normalizeTypeName' :: String -> String
normalizeTypeName' = Text -> String
Text.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeTypeName (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

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