{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE TypeOperators       #-}

module Elm.Generate
       ( Settings (..)
       , defaultSettings
       , generateElm

         -- * Internal helpers
       , RenderElm (..)
       ) where

import Data.Kind (Type)
import Data.List (intercalate)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((<.>), (</>))

import Elm.Generic (Elm (..))
import Elm.Print (decodeChar, decodeEither, decodeEnum, decodePair, decodeTriple, encodeEither, encodeMaybe,
                  encodePair, encodeTriple, prettyShowDecoder, prettyShowDefinition, prettyShowEncoder)

import qualified Data.Text as T
import qualified Data.Text.IO as TIO


-- | Settings for outputting generated Elm code.
data Settings = Settings
    { Settings -> FilePath
settingsDirectory   :: !FilePath    -- ^ Directory to put generated files, e.g. @frontend\/src@
    , Settings -> [FilePath]
settingsModule      :: ![FilePath]  -- ^ List of module parts, like @["ABC", "Core"]@
    , Settings -> FilePath
settingsTypesFile   :: !FilePath    -- ^ File name for module with types, e.g. @Types@
    , Settings -> FilePath
settingsEncoderFile :: !FilePath    -- ^ File name for module with JSON encoders, e.g. @Encoder@
    , Settings -> FilePath
settingsDecoderFile :: !FilePath    -- ^ File name for module with JSON decoders, e.g. @Decoder@
    }

{- | Default settings for generating Elm definitions. You only need to pass name
of the directory and module path prefix. Other settings parameters set to:

1. 'settingsTypesFile': @Types@
2. 'settingsEncoderFile': @Encoder@
3. 'settingsDecoderFile': @Decoder@
-}
defaultSettings :: FilePath -> [FilePath] -> Settings
defaultSettings :: FilePath -> [FilePath] -> Settings
defaultSettings FilePath
settingsDirectory [FilePath]
settingsModule = Settings :: FilePath
-> [FilePath] -> FilePath -> FilePath -> FilePath -> Settings
Settings
    { settingsTypesFile :: FilePath
settingsTypesFile   = FilePath
"Types"
    , settingsEncoderFile :: FilePath
settingsEncoderFile = FilePath
"Encoder"
    , settingsDecoderFile :: FilePath
settingsDecoderFile = FilePath
"Decoder"
    , FilePath
[FilePath]
settingsModule :: [FilePath]
settingsDirectory :: FilePath
settingsModule :: [FilePath]
settingsDirectory :: FilePath
..
    }

-- | Typeclass for generating elm definitions for the list of types.
class RenderElm (types :: [Type]) where
    renderType    :: [Text]
    renderEncoder :: [Text]
    renderDecoder :: [Text]

instance RenderElm '[] where
    renderType :: [Text]
renderType    = []
    renderEncoder :: [Text]
renderEncoder = []
    renderDecoder :: [Text]
renderDecoder = []

instance (Elm t, RenderElm ts) => RenderElm (t ': ts) where
    renderType :: [Text]
renderType    = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Elm t => Text
forall a. Elm a => Text
toElmTypeSource    @t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: RenderElm ts => [Text]
forall (types :: [*]). RenderElm types => [Text]
renderType    @ts
    renderEncoder :: [Text]
renderEncoder = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Elm t => Text
forall a. Elm a => Text
toElmEncoderSource @t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: RenderElm ts => [Text]
forall (types :: [*]). RenderElm types => [Text]
renderEncoder @ts
    renderDecoder :: [Text]
renderDecoder = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Elm t => Text
forall a. Elm a => Text
toElmDecoderSource @t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: RenderElm ts => [Text]
forall (types :: [*]). RenderElm types => [Text]
renderDecoder @ts

toElmTypeSource :: forall a . Elm a => Text
toElmTypeSource :: Text
toElmTypeSource = ElmDefinition -> Text
prettyShowDefinition (ElmDefinition -> Text) -> ElmDefinition -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> ElmDefinition
forall a. Elm a => Proxy a -> ElmDefinition
toElmDefinition (Proxy a -> ElmDefinition) -> Proxy a -> ElmDefinition
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a

toElmEncoderSource :: forall a . Elm a => Text
toElmEncoderSource :: Text
toElmEncoderSource = ElmDefinition -> Text
prettyShowEncoder (ElmDefinition -> Text) -> ElmDefinition -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> ElmDefinition
forall a. Elm a => Proxy a -> ElmDefinition
toElmDefinition (Proxy a -> ElmDefinition) -> Proxy a -> ElmDefinition
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a

toElmDecoderSource :: forall a . Elm a => Text
toElmDecoderSource :: Text
toElmDecoderSource = ElmDefinition -> Text
prettyShowDecoder (ElmDefinition -> Text) -> ElmDefinition -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> ElmDefinition
forall a. Elm a => Proxy a -> ElmDefinition
toElmDefinition (Proxy a -> ElmDefinition) -> Proxy a -> ElmDefinition
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a

{- | Generate elm definitions for the list of types. This function is supposed
to be called like this:

@
__type__ Types =
   '[ User
    , UserStatus
    , Measure
    ]

main :: IO ()
main = generateElm @Types $ defaultSettings "frontend\/src\/" ["ABC", "Core"]
@
-}
generateElm :: forall (ts :: [Type]) . RenderElm ts => Settings -> IO ()
generateElm :: Settings -> IO ()
generateElm Settings{FilePath
[FilePath]
settingsDecoderFile :: FilePath
settingsEncoderFile :: FilePath
settingsTypesFile :: FilePath
settingsModule :: [FilePath]
settingsDirectory :: FilePath
settingsDecoderFile :: Settings -> FilePath
settingsEncoderFile :: Settings -> FilePath
settingsTypesFile :: Settings -> FilePath
settingsModule :: Settings -> [FilePath]
settingsDirectory :: Settings -> FilePath
..} = do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
fullPath

    FilePath -> [Text] -> IO ()
writeElm FilePath
settingsTypesFile   ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
typesHeader   Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: RenderElm ts => [Text]
forall (types :: [*]). RenderElm types => [Text]
renderType    @ts
    FilePath -> [Text] -> IO ()
writeElm FilePath
settingsEncoderFile ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
encoderHeader Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: RenderElm ts => [Text]
forall (types :: [*]). RenderElm types => [Text]
renderEncoder @ts
    FilePath -> [Text] -> IO ()
writeElm FilePath
settingsDecoderFile ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
decoderHeader Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: RenderElm ts => [Text]
forall (types :: [*]). RenderElm types => [Text]
renderDecoder @ts

    FilePath -> [Text] -> IO ()
writeElm FilePath
"ElmStreet" [Text]
elmStreetDefinitions
  where
    moduleDir, fullPath :: FilePath
    moduleDir :: FilePath
moduleDir = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
(</>) FilePath
"" [FilePath]
settingsModule
    fullPath :: FilePath
fullPath  = FilePath
settingsDirectory FilePath -> FilePath -> FilePath
</> FilePath
moduleDir

    writeElm :: FilePath -> [Text] -> IO ()
    writeElm :: FilePath -> [Text] -> IO ()
writeElm FilePath
file [Text]
defs = FilePath -> Text -> IO ()
TIO.writeFile (FilePath
fullPath FilePath -> FilePath -> FilePath
</> FilePath
file FilePath -> FilePath -> FilePath
<.> FilePath
"elm") ([Text] -> Text
T.unlines [Text]
defs)

    joinModule :: [String] -> Text
    joinModule :: [FilePath] -> Text
joinModule = FilePath -> Text
T.pack (FilePath -> Text)
-> ([FilePath] -> FilePath) -> [FilePath] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"."

    typesModule, encoderModule, decoderModule :: Text
    typesModule :: Text
typesModule   = [FilePath] -> Text
joinModule ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath]
settingsModule [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
settingsTypesFile]
    encoderModule :: Text
encoderModule = [FilePath] -> Text
joinModule ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath]
settingsModule [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
settingsEncoderFile]
    decoderModule :: Text
decoderModule = [FilePath] -> Text
joinModule ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath]
settingsModule [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
settingsDecoderFile]
    streetModule :: Text
streetModule  = [FilePath] -> Text
joinModule ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath]
settingsModule [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"ElmStreet"]

    typesHeader :: Text
    typesHeader :: Text
typesHeader = [Text] -> Text
T.unlines
        [ Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typesModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exposing (..)"
        , Text
""
        , Text
"import Time exposing (Posix)"
        ]

    encoderHeader :: Text
    encoderHeader :: Text
encoderHeader = [Text] -> Text
T.unlines
        [ Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
encoderModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exposing (..)"
        , Text
""
        , Text
"import Iso8601 as Iso"
        , Text
"import Json.Encode as E exposing (..)"
        , Text
""
        , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
streetModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exposing (..)"
        , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typesModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as T"
        ]

    decoderHeader :: Text
    decoderHeader :: Text
decoderHeader = [Text] -> Text
T.unlines
        [ Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
decoderModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exposing (..)"
        , Text
""
        , Text
"import Iso8601 as Iso"
        , Text
"import Json.Decode as D exposing (..)"
        , Text
"import Json.Decode.Pipeline as D exposing (required)"
        , Text
""
        , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
streetModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exposing (..)"
        , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typesModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as T"
        ]

    elmStreetDefinitions :: [Text]
    elmStreetDefinitions :: [Text]
elmStreetDefinitions =
        [ Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
streetModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exposing (..)"
        , Text
""
        , Text
"import Json.Encode as E exposing (Value)"
        , Text
"import Json.Decode as D exposing (Decoder)"
        , Text
"import Json.Decode.Pipeline as D exposing (..)"
        , Text
""
        , Text
""
        , Text
encodeMaybe
        , Text
encodeEither
        , Text
encodePair
        , Text
encodeTriple

        , Text
decodeEnum
        , Text
decodeChar
        , Text
decodeEither
        , Text
decodePair
        , Text
decodeTriple
        ]