Generate.hs

{-# 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, encodeEither, encodeMaybe,
                  encodePair, 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
    { settingsDirectory   :: !FilePath    -- ^ Directory to put generated files, e.g. @frontend\/src@
    , settingsModule      :: ![FilePath]  -- ^ List of module parts, like @["ABC", "Core"]@
    , settingsTypesFile   :: !FilePath    -- ^ File name for module with types, e.g. @Types@
    , settingsEncoderFile :: !FilePath    -- ^ File name for module with JSON encoders, e.g. @Encoder@
    , 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 settingsDirectory settingsModule = Settings
    { settingsTypesFile   = "Types"
    , settingsEncoderFile = "Encoder"
    , settingsDecoderFile = "Decoder"
    , ..
    }

-- | 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    = []
    renderEncoder = []
    renderDecoder = []

instance (Elm t, RenderElm ts) => RenderElm (t ': ts) where
    renderType    = "" : toElmTypeSource    @t : renderType    @ts
    renderEncoder = "" : toElmEncoderSource @t : renderEncoder @ts
    renderDecoder = "" : toElmDecoderSource @t : renderDecoder @ts

toElmTypeSource :: forall a . Elm a => Text
toElmTypeSource = prettyShowDefinition $ toElmDefinition $ Proxy @a

toElmEncoderSource :: forall a . Elm a => Text
toElmEncoderSource = prettyShowEncoder $ toElmDefinition $ Proxy @a

toElmDecoderSource :: forall a . Elm a => Text
toElmDecoderSource = prettyShowDecoder $ toElmDefinition $ 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{..} = do
    createDirectoryIfMissing True fullPath

    writeElm settingsTypesFile   $ typesHeader   : renderType    @ts
    writeElm settingsEncoderFile $ encoderHeader : renderEncoder @ts
    writeElm settingsDecoderFile $ decoderHeader : renderDecoder @ts

    writeElm "ElmStreet" elmStreetDefinitions
  where
    moduleDir, fullPath :: FilePath
    moduleDir = foldr (</>) "" settingsModule
    fullPath  = settingsDirectory </> moduleDir

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

    joinModule :: [String] -> Text
    joinModule = T.pack . intercalate "."

    typesModule, encoderModule, decoderModule :: Text
    typesModule   = joinModule $ settingsModule ++ [settingsTypesFile]
    encoderModule = joinModule $ settingsModule ++ [settingsEncoderFile]
    decoderModule = joinModule $ settingsModule ++ [settingsDecoderFile]
    streetModule  = joinModule $ settingsModule ++ ["ElmStreet"]

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

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

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

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

        , decodeEnum
        , decodeChar
        , decodeEither
        , decodePair
        ]