{-# 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, decodeNonEmpty, encodeEither, encodeMaybe, encodeNonEmpty,
encodePair, encodeTriple, prettyShowDecoder, prettyShowDefinition, prettyShowEncoder)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
data Settings = Settings
{ Settings -> FilePath
settingsDirectory :: !FilePath
, Settings -> [FilePath]
settingsModule :: ![FilePath]
, Settings -> FilePath
settingsTypesFile :: !FilePath
, Settings -> FilePath
settingsEncoderFile :: !FilePath
, Settings -> FilePath
settingsDecoderFile :: !FilePath
}
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
..
}
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
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)"
, Text
"import Json.Decode exposing (Value)"
]
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
encodeNonEmpty
, Text
decodeEnum
, Text
decodeChar
, Text
decodeEither
, Text
decodePair
, Text
decodeTriple
, Text
decodeNonEmpty
]