{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
module Elm.Generate
( Settings (..)
, defaultSettings
, generateElm
, 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
data Settings = Settings
{ settingsDirectory :: !FilePath
, settingsModule :: ![FilePath]
, settingsTypesFile :: !FilePath
, settingsEncoderFile :: !FilePath
, settingsDecoderFile :: !FilePath
}
defaultSettings :: FilePath -> [FilePath] -> Settings
defaultSettings settingsDirectory settingsModule = Settings
{ settingsTypesFile = "Types"
, settingsEncoderFile = "Encoder"
, settingsDecoderFile = "Decoder"
, ..
}
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
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 <> " as T"
]
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 <> " as T"
]
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
, encodeTriple
, decodeEnum
, decodeChar
, decodeEither
, decodePair
, decodeTriple
]