From 2ed635a49fbe0d2949e1cab96115b4bb6c62433e Mon Sep 17 00:00:00 2001 From: dneaves Date: Sun, 12 Jul 2026 14:36:37 -0400 Subject: [PATCH] Commit whatever this was --- app/Cli.hs | 65 -- app/Common/Utils.hs | 154 ---- app/Config/Extras.hs | 52 -- app/DataTypeTool/Cli.hs | 76 ++ app/DataTypeTool/Common/Utils.hs | 145 +++ app/{ => DataTypeTool}/Config/Config.hs | 140 ++- app/DataTypeTool/Config/Extras.hs | 56 ++ app/DataTypeTool/Lang/DTT/Config.hs | 23 + app/DataTypeTool/Lang/DTT/Default.hs | 97 ++ app/DataTypeTool/Lang/Elm/Config.hs | 13 + app/DataTypeTool/Lang/Elm/Models.hs | 77 ++ app/DataTypeTool/Lang/Elm/Toml.hs | 20 + .../Lang/Elm/Versions/ElmZeroNineteenOne.hs | 573 ++++++++++++ app/DataTypeTool/Lang/Elm/Writer.hs | 22 + app/DataTypeTool/Lang/Gleam/Config.hs | 17 + app/DataTypeTool/Lang/Gleam/Models.hs | 38 + app/DataTypeTool/Lang/Gleam/Toml.hs | 38 + .../Lang/Gleam/Versions/GleamOneZeroZero.hs | 631 +++++++++++++ app/DataTypeTool/Lang/Gleam/Writer.hs | 22 + app/DataTypeTool/Lang/Haskell/Config.hs | 14 + app/DataTypeTool/Lang/Haskell/Models.hs | 40 + app/DataTypeTool/Lang/Haskell/Toml.hs | 28 + .../Lang/Haskell/Versions/GHCNineEightOne.hs | 595 +++++++++++++ app/DataTypeTool/Lang/Haskell/Writer.hs | 22 + app/DataTypeTool/Lang/Python/Config.hs | 13 + app/DataTypeTool/Lang/Python/Models.hs | 38 + app/DataTypeTool/Lang/Python/Toml.hs | 27 + .../Python/Versions/CPythonThreeTenTwelve.hs | 603 +++++++++++++ app/DataTypeTool/Lang/Python/Writer.hs | 27 + app/DataTypeTool/Parsing/Parser.hs | 828 ++++++++++++++++++ app/DataTypeTool/Parsing/ParserOld.hs | 828 ++++++++++++++++++ app/DataTypeTool/Parsing/Raw.hs | 112 +++ app/DataTypeTool/Parsing/Types.hs | 119 +++ app/DataTypeTool/Parsing/Valid.hs | 1 + app/DataTypeTool/Parsing/Validate.hs | 16 + app/Instances.hs | 17 - app/Lang/Elm/Config.hs | 16 - app/Lang/Elm/Toml.hs | 19 - app/Lang/Elm/Versions/ElmZeroNineteenOne.hs | 585 ------------- app/Lang/Elm/Writer.hs | 17 - app/Lang/Gleam/Config.hs | 20 - app/Lang/Gleam/Toml.hs | 35 - app/Lang/Gleam/Versions/GleamOneZeroZero.hs | 634 -------------- app/Lang/Gleam/Writer.hs | 17 - app/Lang/Haskell/Config.hs | 15 - app/Lang/Haskell/Toml.hs | 23 - app/Lang/Haskell/Versions/GHCNineEightOne.hs | 598 ------------- app/Lang/Haskell/Writer.hs | 17 - app/Lang/Python/Config.hs | 14 - app/Lang/Python/Toml.hs | 19 - .../Python/Versions/CPythonThreeTenTwelve.hs | 607 ------------- app/Lang/Python/Writer.hs | 22 - app/Main.hs | 250 ++++-- app/Parsing/Parser.hs | 721 --------------- app/Parsing/Types.hs | 129 --- app/Prelude.hs | 18 + datatypetool.cabal | 61 +- exampleProject/app/DTT/BasicTest.hs | 83 -- exampleProject/app/DTT/Folder/AnotherTest.hs | 44 - exampleProject/app/DTT/Folder/ComplexTests.hs | 41 - exampleProject/app/DTT/TestFile.hs | 89 -- exampleProject/app/Main.hs | 29 - exampleProject/app/dtt/basic_test.py | 82 -- exampleProject/app/dtt/folder/another_test.py | 40 - .../app/dtt/folder/complex_tests.py | 34 - exampleProject/app/dtt/test_file.py | 85 -- exampleProject/datatypetool.toml | 41 +- exampleProject/elm.json | 11 +- exampleProject/exampleProject.cabal | 22 - exampleProject/gleam.toml | 20 - exampleProject/manifest.toml | 14 - exampleProject/notes.md | 11 - exampleProject/runtest.py | 35 - exampleProject/src/DTT/BasicTest.elm | 84 -- exampleProject/src/DTT/Example.elm | 44 + exampleProject/src/DTT/Folder/AnotherTest.elm | 43 - .../src/DTT/Folder/ComplexTests.elm | 40 - exampleProject/src/DTT/TestFile.elm | 90 -- exampleProject/src/ElmTest.elm | 59 -- exampleProject/src/dtt/basic_test.gleam | 90 -- .../src/dtt/folder/another_test.gleam | 46 - .../src/dtt/folder/complex_tests.gleam | 39 - exampleProject/src/dtt/test_file.gleam | 89 -- exampleProject/src/test_project.gleam | 31 - exampleProject/test.json | 21 - exampleProject/types/Basic_Test.type | 40 - exampleProject/types/Example.type | 22 + exampleProject/types/Folder/Another_Test.type | 14 - .../types/Folder/Complex_Tests.type | 20 - exampleProject/types/Test_File.type | 54 -- fourmolu.yaml | 67 ++ justfile | 7 +- 92 files changed, 5577 insertions(+), 5428 deletions(-) delete mode 100644 app/Cli.hs delete mode 100644 app/Common/Utils.hs delete mode 100644 app/Config/Extras.hs create mode 100644 app/DataTypeTool/Cli.hs create mode 100644 app/DataTypeTool/Common/Utils.hs rename app/{ => DataTypeTool}/Config/Config.hs (52%) create mode 100644 app/DataTypeTool/Config/Extras.hs create mode 100644 app/DataTypeTool/Lang/DTT/Config.hs create mode 100644 app/DataTypeTool/Lang/DTT/Default.hs create mode 100644 app/DataTypeTool/Lang/Elm/Config.hs create mode 100644 app/DataTypeTool/Lang/Elm/Models.hs create mode 100644 app/DataTypeTool/Lang/Elm/Toml.hs create mode 100644 app/DataTypeTool/Lang/Elm/Versions/ElmZeroNineteenOne.hs create mode 100644 app/DataTypeTool/Lang/Elm/Writer.hs create mode 100644 app/DataTypeTool/Lang/Gleam/Config.hs create mode 100644 app/DataTypeTool/Lang/Gleam/Models.hs create mode 100644 app/DataTypeTool/Lang/Gleam/Toml.hs create mode 100644 app/DataTypeTool/Lang/Gleam/Versions/GleamOneZeroZero.hs create mode 100644 app/DataTypeTool/Lang/Gleam/Writer.hs create mode 100644 app/DataTypeTool/Lang/Haskell/Config.hs create mode 100644 app/DataTypeTool/Lang/Haskell/Models.hs create mode 100644 app/DataTypeTool/Lang/Haskell/Toml.hs create mode 100644 app/DataTypeTool/Lang/Haskell/Versions/GHCNineEightOne.hs create mode 100644 app/DataTypeTool/Lang/Haskell/Writer.hs create mode 100644 app/DataTypeTool/Lang/Python/Config.hs create mode 100644 app/DataTypeTool/Lang/Python/Models.hs create mode 100644 app/DataTypeTool/Lang/Python/Toml.hs create mode 100644 app/DataTypeTool/Lang/Python/Versions/CPythonThreeTenTwelve.hs create mode 100644 app/DataTypeTool/Lang/Python/Writer.hs create mode 100644 app/DataTypeTool/Parsing/Parser.hs create mode 100644 app/DataTypeTool/Parsing/ParserOld.hs create mode 100644 app/DataTypeTool/Parsing/Raw.hs create mode 100644 app/DataTypeTool/Parsing/Types.hs create mode 100644 app/DataTypeTool/Parsing/Valid.hs create mode 100644 app/DataTypeTool/Parsing/Validate.hs delete mode 100644 app/Instances.hs delete mode 100644 app/Lang/Elm/Config.hs delete mode 100644 app/Lang/Elm/Toml.hs delete mode 100644 app/Lang/Elm/Versions/ElmZeroNineteenOne.hs delete mode 100644 app/Lang/Elm/Writer.hs delete mode 100644 app/Lang/Gleam/Config.hs delete mode 100644 app/Lang/Gleam/Toml.hs delete mode 100644 app/Lang/Gleam/Versions/GleamOneZeroZero.hs delete mode 100644 app/Lang/Gleam/Writer.hs delete mode 100644 app/Lang/Haskell/Config.hs delete mode 100644 app/Lang/Haskell/Toml.hs delete mode 100644 app/Lang/Haskell/Versions/GHCNineEightOne.hs delete mode 100644 app/Lang/Haskell/Writer.hs delete mode 100644 app/Lang/Python/Config.hs delete mode 100644 app/Lang/Python/Toml.hs delete mode 100644 app/Lang/Python/Versions/CPythonThreeTenTwelve.hs delete mode 100644 app/Lang/Python/Writer.hs delete mode 100644 app/Parsing/Parser.hs delete mode 100644 app/Parsing/Types.hs delete mode 100644 exampleProject/app/DTT/BasicTest.hs delete mode 100644 exampleProject/app/DTT/Folder/AnotherTest.hs delete mode 100644 exampleProject/app/DTT/Folder/ComplexTests.hs delete mode 100644 exampleProject/app/DTT/TestFile.hs delete mode 100644 exampleProject/app/Main.hs delete mode 100644 exampleProject/app/dtt/basic_test.py delete mode 100644 exampleProject/app/dtt/folder/another_test.py delete mode 100644 exampleProject/app/dtt/folder/complex_tests.py delete mode 100644 exampleProject/app/dtt/test_file.py delete mode 100644 exampleProject/exampleProject.cabal delete mode 100644 exampleProject/gleam.toml delete mode 100644 exampleProject/manifest.toml delete mode 100644 exampleProject/notes.md delete mode 100755 exampleProject/runtest.py delete mode 100644 exampleProject/src/DTT/BasicTest.elm create mode 100644 exampleProject/src/DTT/Example.elm delete mode 100644 exampleProject/src/DTT/Folder/AnotherTest.elm delete mode 100644 exampleProject/src/DTT/Folder/ComplexTests.elm delete mode 100644 exampleProject/src/DTT/TestFile.elm delete mode 100644 exampleProject/src/ElmTest.elm delete mode 100644 exampleProject/src/dtt/basic_test.gleam delete mode 100644 exampleProject/src/dtt/folder/another_test.gleam delete mode 100644 exampleProject/src/dtt/folder/complex_tests.gleam delete mode 100644 exampleProject/src/dtt/test_file.gleam delete mode 100644 exampleProject/src/test_project.gleam delete mode 100644 exampleProject/test.json delete mode 100644 exampleProject/types/Basic_Test.type create mode 100644 exampleProject/types/Example.type delete mode 100644 exampleProject/types/Folder/Another_Test.type delete mode 100644 exampleProject/types/Folder/Complex_Tests.type delete mode 100644 exampleProject/types/Test_File.type create mode 100644 fourmolu.yaml diff --git a/app/Cli.hs b/app/Cli.hs deleted file mode 100644 index 88754da..0000000 --- a/app/Cli.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Cli where - -import qualified Antelude.List as List -import Antelude.String (fromString) -import Data.Version (showVersion) -import Options.Applicative ((<**>)) -import qualified Options.Applicative as Opts -import Paths_datatypetool (version) -import qualified System.Directory as Dir - -data Flags = - Flags - { tomlPath :: FilePath - , verbosity :: Verbosity - } - deriving (Show, Eq, Ord) - -data Verbosity - = Basic - | Extra - | Debug - | Silly - deriving (Show, Eq, Ord) - -opts :: FilePath -> Opts.ParserInfo Flags -opts cwd = let - parseFlags :: Opts.Parser Flags - parseFlags = Flags - <$> ( ( Opts.strOption - ( Opts.long "toml" - <> Opts.short 't' - <> Opts.metavar "FILE" - <> Opts.help "A datatypetool.toml file path, if not within the current working directory" - ) - |> Opts.liftA (\a -> fromString a :: FilePath) - ) - <|> pure (cwd <> fromString "/datatypetool.toml" :: FilePath) - ) - <*> ( ( List.length - <$> Opts.many - (Opts.flag' - Basic - ( Opts.short 'v' - <> Opts.help "Increase verbosity, up to three times" - ) - ) - ) - |> Opts.liftA - (\case - 0 -> Basic - 1 -> Extra - 2 -> Debug - _ -> Silly - ) - ) - - in - Opts.info - (parseFlags <**> Opts.simpleVersioner (showVersion version) <**> Opts.helper) - ( Opts.fullDesc - <> Opts.progDesc - "Create types that work across your entire stack.\n\ - \ This CLI reads a datatypetool.toml file and creates types for\ - \ all specified languages from a set of *.type files." - ) diff --git a/app/Common/Utils.hs b/app/Common/Utils.hs deleted file mode 100644 index 36a27c9..0000000 --- a/app/Common/Utils.hs +++ /dev/null @@ -1,154 +0,0 @@ -module Common.Utils where - - -import qualified Antelude.Function as Function -import qualified Antelude.List as List -import qualified Antelude.Maybe as Maybe -import qualified Antelude.String.Case as Case -import qualified Antelude.Tuple.Pair as Pair -import Control.Monad (mapM) -import qualified Data.Char as Char -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import Data.Traversable (mapAccumM) -import qualified System.Directory as Dir -import System.FilePath (pathSeparator) -import System.IO (readFile') -import qualified Text.Casing as Casing - - -data CaseType - = PascalCase - | CamelCase - | ScreamingCase - | CapitalizedSnakeCase - | QuietSnakeCase - | ScreamingSnakeCase - - -typeFilePathToLangFilePath :: CaseType -> FilePath -> FilePath -> FilePath -typeFilePathToLangFilePath caseType newExtension typeRelPath = let - caseFn :: (String -> String) - caseFn = case caseType of - PascalCase -> Casing.pascal - CamelCase -> Casing.camel - ScreamingCase -> List.map Char.toUpper - CapitalizedSnakeCase -> Function.identity - QuietSnakeCase -> Casing.quietSnake - ScreamingSnakeCase -> Casing.screamingSnake - in - typeRelPath - |> List.reverse -- Drop .type suffix - |> List.stripPrefix (List.reverse ".type") - |> Maybe.withDefault - (List.reverse typeRelPath) - |> List.reverse - |> List.drop 1 -- Remove prefixed '/' or '\\' - |> split pathSeparator -- Split at '/' or '\\' - |> List.map caseFn -- Case-ify - |> List.intersperse [pathSeparator] -- Reinsert '/' or '\\' - |> ([pathSeparator] :) -- Readd prefixed '/' or '\\' - |> List.concat -- Merge - |> (<> newExtension) -- New Extension - --- The same as above, but without the actual file. --- Used with System.Directory.createDirectoryIfMissing to ensure we can write. -typeFilePathToLangDirPath :: CaseType -> FilePath -> FilePath -typeFilePathToLangDirPath caseType typeRelPath = let - caseFn :: (String -> String) - caseFn = case caseType of - PascalCase -> Casing.pascal - CamelCase -> Casing.camel - ScreamingCase -> List.map Char.toUpper - CapitalizedSnakeCase -> Function.identity - QuietSnakeCase -> Casing.quietSnake - ScreamingSnakeCase -> Casing.screamingSnake - in - typeRelPath - |> List.reverse -- Drop .type suffix - |> List.dropWhile (/= pathSeparator) - |> List.reverse - |> List.drop 1 -- Remove prefixed '/' or '\\' - |> split pathSeparator -- Split at '/' or '\\' - |> List.map caseFn -- Case-ify - |> List.intersperse [pathSeparator] -- Reinsert '/' or '\\' - |> ([pathSeparator] :) -- Readd prefixed '/' or '\\' - |> List.concat -- Merge - - -typeFilePathToLangCodePath :: CaseType -> Char -> FilePath -> String -typeFilePathToLangCodePath caseType separator typeRelPath = let - caseFn :: (String -> String) - caseFn = case caseType of - PascalCase -> Casing.pascal - CamelCase -> Casing.camel - ScreamingCase -> List.map Char.toUpper - CapitalizedSnakeCase -> Function.identity - QuietSnakeCase -> Casing.quietSnake - ScreamingSnakeCase -> Casing.screamingSnake - in - typeRelPath - |> List.reverse -- Drop .type suffix - |> List.stripPrefix (List.reverse ".type") - |> Maybe.withDefault - (List.reverse typeRelPath) - |> List.reverse - |> List.dropWhile (== pathSeparator) -- Remove prefixed '/' or '\\' - |> split pathSeparator -- Split at '/' or '\\' - |> List.map caseFn -- Case-ify - |> List.intersperse [separator] -- Insert langage's file separator - |> List.concat -- Merge - - -split :: Char -> String -> [String] -split chr str = case List.break (==chr) str of - (a, chr:b) -> a : split chr b - (a, "") -> [a] - - -recurseDirectory :: FilePath -> IO [(FilePath, String)] -recurseDirectory dp = - let - traverseDirs :: - [(FilePath, String)] -> - FilePath -> - IO ([(FilePath, String)], [(FilePath, String)]) - traverseDirs state pth = let - fullPth :: FilePath - fullPth = dp - <> [pathSeparator] - <> pth - in Dir.doesDirectoryExist fullPth >>= \case - True -> recurseDirectory fullPth - >>= \dirsResult -> return (state <> dirsResult, dirsResult) - False -> Dir.doesFileExist fullPth >>= \case - True -> if List.isSuffixOf ".type" fullPth - then readFile' fullPth - >>= \result -> - return - ( state <> [(fullPth, result)] - , [(fullPth, result)] - ) - else return (state, []) - False -> return (state, []) - in Dir.listDirectory dp - >>= mapAccumM traverseDirs [] - >>= return <. Pair.first - - -createWritePath :: FilePath -> IO () -createWritePath = - Dir.createDirectoryIfMissing True - - -between :: Ord a => a -> a -> a -> Bool -between input lower upper = - lower < input && input < upper - -betweenOrEqualLower :: Ord a => a -> a -> a -> Bool -betweenOrEqualLower input lower upper = - lower <= input && input < upper - -betweenOrEqualUpper :: Ord a => a -> a -> a -> Bool -betweenOrEqualUpper input lower upper = - lower < input && input <= upper diff --git a/app/Config/Extras.hs b/app/Config/Extras.hs deleted file mode 100644 index 74fb480..0000000 --- a/app/Config/Extras.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Config.Extras where - -import qualified Antelude.List as List -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import qualified Data.Version as Version -import Text.Read (readMaybe) -import qualified Toml -import Toml ((.=)) - -versionCodec :: Toml.Key -> Toml.TomlCodec Version.Version -versionCodec key = let - splitByDot :: String -> [String] - splitByDot str = case List.dropWhile (=='.') str of - "" -> [] - str' -> w : splitByDot str'' - where (w, str'') = List.break (=='.') str' - - strToVersion :: String -> Version.Version - strToVersion str = - str - |> splitByDot - |> List.map - (\s -> - (readMaybe s :: Maybe Int) - |> \case - Just a -> a - Nothing -> 0 - ) - |> Version.makeVersion - in - Toml.dimap - Version.showVersion - strToVersion - (Toml.string key) - - - -optionalTextConsiderBlanks :: Toml.Key -> Toml.TomlCodec (Maybe Text) -optionalTextConsiderBlanks key = Toml.dioptional (Toml.text key) |> considerBlankAsNothing - where - considerJustBlank :: Maybe Text -> Maybe Text - considerJustBlank (Nothing) = Nothing - considerJustBlank (Just "") = Nothing - considerJustBlank (Just s ) = Just s - - considerBlankAsNothing :: Toml.TomlCodec (Maybe Text) -> Toml.TomlCodec (Maybe Text) - considerBlankAsNothing = - Toml.dimap - considerJustBlank - considerJustBlank diff --git a/app/DataTypeTool/Cli.hs b/app/DataTypeTool/Cli.hs new file mode 100644 index 0000000..f6dfc95 --- /dev/null +++ b/app/DataTypeTool/Cli.hs @@ -0,0 +1,76 @@ +module DataTypeTool.Cli where + +import qualified Antelude.List as List +import Antelude.String ( fromString ) + +import Data.Version ( showVersion ) + +import Options.Applicative ( (<**>) ) +import qualified Options.Applicative as Opts + +import Paths_datatypetool ( version ) + +import qualified System.Directory as Dir + +data Flags + = Flags + { tomlPath :: FilePath + , verbosity :: Verbosity + } + deriving (Eq, Ord, Show) + +data Verbosity = Basic | Extra | Debug | Silly + deriving (Eq, Ord, Show) + +opts :: FilePath -> Opts.ParserInfo Flags +opts cwd = + let parseFlags :: Opts.Parser Flags + parseFlags = + Flags + <$> ( ( Opts.strOption + ( Opts.long "toml" + <> Opts.short 't' + <> Opts.metavar "FILE" + <> Opts.help "A datatypetool.toml file path, if not within the current working directory" + ) + |> Opts.liftA (\a -> fromString a :: FilePath) + ) + <|> pure (cwd <> fromString "/datatypetool.toml" :: FilePath) + ) + <*> ( ( List.length + <$> Opts.many + ( Opts.flag' + Basic + ( Opts.short 'v' + <> Opts.help "Increase verbosity, up to three times" + ) + ) + ) + |> Opts.liftA + ( \case + 0 -> Basic + 1 -> Extra + 2 -> Debug + _ -> Silly + ) + ) + in Opts.info + (parseFlags <**> Opts.simpleVersioner (showVersion version) <**> Opts.helper) + ( Opts.fullDesc + <> Opts.progDesc + "Create types that work across your entire stack.\n\ + \ This CLI reads a datatypetool.toml file and creates types for\ + \ all specified languages from a set of *.type files." + ) + +yeses :: List String +yeses = + [ "y" + , "yes" + ] + +nos :: List String +nos = + [ "n" + , "no" + ] diff --git a/app/DataTypeTool/Common/Utils.hs b/app/DataTypeTool/Common/Utils.hs new file mode 100644 index 0000000..f668276 --- /dev/null +++ b/app/DataTypeTool/Common/Utils.hs @@ -0,0 +1,145 @@ +module DataTypeTool.Common.Utils where + +import qualified Antelude.Function as Function +import qualified Antelude.List as List +import qualified Antelude.Maybe as Maybe +import qualified Antelude.String.Case as Case +import qualified Antelude.Tuple.Pair as Pair + +import Control.Monad ( mapM ) + +import qualified Data.Char as Char +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text +import Data.Traversable ( mapAccumM ) + +import qualified System.Directory as Dir +import System.FilePath ( pathSeparator ) +import System.IO ( readFile' ) + +import qualified Text.Casing as Casing + +data CaseType = PascalCase | CamelCase | ScreamingCase | CapitalizedSnakeCase | QuietSnakeCase | ScreamingSnakeCase + +typeFilePathToLangFilePath :: CaseType -> FilePath -> FilePath -> FilePath +typeFilePathToLangFilePath caseType newExtension typeRelPath = + let caseFn :: (String -> String) + caseFn = case caseType of + PascalCase -> Casing.pascal + CamelCase -> Casing.camel + ScreamingCase -> List.map Char.toUpper + CapitalizedSnakeCase -> Function.identity + QuietSnakeCase -> Casing.quietSnake + ScreamingSnakeCase -> Casing.screamingSnake + in typeRelPath + |> List.reverse -- Drop .type suffix + |> List.stripPrefix (List.reverse ".type") + |> Maybe.withDefault + (List.reverse typeRelPath) + |> List.reverse + |> List.drop 1 -- Remove prefixed '/' or '\\' + |> split pathSeparator -- Split at '/' or '\\' + |> List.map caseFn -- Case-ify + |> List.intersperse [pathSeparator] -- Reinsert '/' or '\\' + |> ([pathSeparator] :) -- Readd prefixed '/' or '\\' + |> List.concat -- Merge + |> (<> newExtension) -- New Extension + +-- The same as above, but without the actual file. +-- Used with System.Directory.createDirectoryIfMissing to ensure we can write. +typeFilePathToLangDirPath :: CaseType -> FilePath -> FilePath +typeFilePathToLangDirPath caseType typeRelPath = + let caseFn :: (String -> String) + caseFn = case caseType of + PascalCase -> Casing.pascal + CamelCase -> Casing.camel + ScreamingCase -> List.map Char.toUpper + CapitalizedSnakeCase -> Function.identity + QuietSnakeCase -> Casing.quietSnake + ScreamingSnakeCase -> Casing.screamingSnake + in typeRelPath + |> List.reverse -- Drop .type suffix + |> List.dropWhile (/= pathSeparator) + |> List.reverse + |> List.drop 1 -- Remove prefixed '/' or '\\' + |> split pathSeparator -- Split at '/' or '\\' + |> List.map caseFn -- Case-ify + |> List.intersperse [pathSeparator] -- Reinsert '/' or '\\' + |> ([pathSeparator] :) -- Readd prefixed '/' or '\\' + |> List.concat -- Merge + +typeFilePathToLangCodePath :: CaseType -> Char -> FilePath -> String +typeFilePathToLangCodePath caseType separator typeRelPath = + let caseFn :: (String -> String) + caseFn = case caseType of + PascalCase -> Casing.pascal + CamelCase -> Casing.camel + ScreamingCase -> List.map Char.toUpper + CapitalizedSnakeCase -> Function.identity + QuietSnakeCase -> Casing.quietSnake + ScreamingSnakeCase -> Casing.screamingSnake + in typeRelPath + |> List.reverse -- Drop .type suffix + |> List.stripPrefix (List.reverse ".type") + |> Maybe.withDefault + (List.reverse typeRelPath) + |> List.reverse + |> List.dropWhile (== pathSeparator) -- Remove prefixed '/' or '\\' + |> split pathSeparator -- Split at '/' or '\\' + |> List.map caseFn -- Case-ify + |> List.intersperse [separator] -- Insert langage's file separator + |> List.concat -- Merge + +split :: Char -> String -> [String] +split chr str = case List.break (== chr) str of + (a, chr : b) -> a : split chr b + (a, "") -> [a] + +recurseDirectory :: FilePath -> IO [(FilePath, String)] +recurseDirectory dp = + let traverseDirs + :: [(FilePath, String)] + -> FilePath + -> IO ([(FilePath, String)], [(FilePath, String)]) + traverseDirs state pth = + let fullPth :: FilePath + fullPth = + dp + <> [pathSeparator] + <> pth + in Dir.doesDirectoryExist fullPth >>= \case + True -> + recurseDirectory fullPth + >>= \dirsResult -> return (state <> dirsResult, dirsResult) + False -> + Dir.doesFileExist fullPth >>= \case + True -> + if List.isSuffixOf ".type" fullPth + then + readFile' fullPth + >>= \result -> + return + ( state <> [(fullPth, result)] + , [(fullPth, result)] + ) + else return (state, []) + False -> return (state, []) + in Dir.listDirectory dp + >>= mapAccumM traverseDirs [] + >>= return <. Pair.first + +createWritePath :: FilePath -> IO () +createWritePath = + Dir.createDirectoryIfMissing True + +between :: (Ord a) => a -> a -> a -> Bool +between input lower upper = + lower < input && input < upper + +betweenOrEqualLower :: (Ord a) => a -> a -> a -> Bool +betweenOrEqualLower input lower upper = + lower <= input && input < upper + +betweenOrEqualUpper :: (Ord a) => a -> a -> a -> Bool +betweenOrEqualUpper input lower upper = + lower < input && input <= upper diff --git a/app/Config/Config.hs b/app/DataTypeTool/Config/Config.hs similarity index 52% rename from app/Config/Config.hs rename to app/DataTypeTool/Config/Config.hs index 1536616..bb0347b 100644 --- a/app/Config/Config.hs +++ b/app/DataTypeTool/Config/Config.hs @@ -1,49 +1,52 @@ -{-# LANGUAGE OverloadedStrings #-} -module Config.Config where +{-# LANGUAGE + OverloadedStrings + #-} -import qualified Antelude.List as List -import qualified Antelude.List.NonEmpty as NE -import qualified Antelude.Maybe as Maybe -import qualified Antelude.Tuple.Pair as Pair -import Control.Applicative -import qualified Data.List.NonEmpty as UnsafeNE -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import qualified Data.Version as Version -import qualified Lang.Elm.Config as ElmConfig -import qualified Lang.Elm.Toml as ElmToml -import qualified Lang.Gleam.Config as GleamConfig -import qualified Lang.Gleam.Toml as GleamToml -import qualified Lang.Haskell.Config as HaskellConfig -import qualified Lang.Haskell.Toml as HaskellToml -import qualified Lang.Python.Config as PythonConfig -import qualified Lang.Python.Toml as PythonToml -import qualified Lang.Python.Writer as PythonWrite -import qualified Parsing.Types as PT -import qualified Toml -import Toml ((.=)) +module DataTypeTool.Config.Config where +import qualified Antelude.List as List +import qualified Antelude.List.NonEmpty as NE +import qualified Antelude.Maybe as Maybe +import qualified Antelude.Tuple.Pair as Pair -data Config = - Config - { sources :: FilePath - , spacing :: Spacing - -- This comment is for testing with regular lists - -- , targets :: [LangConfiguration] - , targets :: NonEmpty LangConfiguration - } +import Control.Applicative +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text +import qualified Data.Version as Version + +import qualified DataTypeTool.Lang.DTT.Config as DTTConfig +import qualified DataTypeTool.Lang.Elm.Config as ElmConfig +import qualified DataTypeTool.Lang.Elm.Toml as ElmToml +import qualified DataTypeTool.Lang.Gleam.Config as GleamConfig +import qualified DataTypeTool.Lang.Gleam.Toml as GleamToml +import qualified DataTypeTool.Lang.Haskell.Config as HaskellConfig +import qualified DataTypeTool.Lang.Haskell.Toml as HaskellToml +import qualified DataTypeTool.Lang.Python.Config as PythonConfig +import qualified DataTypeTool.Lang.Python.Toml as PythonToml +import qualified DataTypeTool.Lang.Python.Writer as PythonWrite +import qualified DataTypeTool.Parsing.Types as PT + +import Toml ( (.=) ) +import qualified Toml + +data Config + = Config + { sources :: FilePath + , spacing :: Spacing + , targets :: NonEmpty LangConfiguration + } datatypetoolCodec :: Toml.TomlCodec Config -datatypetoolCodec = Config - <$> Toml.table +datatypetoolCodec = + Config + <$> Toml.table (Toml.string "sources") "datatypetool" - - .= sources - <*> Toml.table + .= sources + <*> Toml.table ( Toml.dioptional - (Toml.dimap + ( Toml.dimap fromSpacing toSpacing (Toml.string "spacing") @@ -53,24 +56,17 @@ datatypetoolCodec = Config (Maybe.withDefault Spaces4) ) "datatypetool" + .= spacing + <*> ( Toml.tableMap + Toml._KeyText + indvLangCodec + "targets" + |> parseTableAsNEList + ) + .= targets - .= spacing - <*> (Toml.tableMap - Toml._KeyText - indvLangCodec - "targets" - |> parseTableAsNEList - ) - .= targets - - -data Spacing - = Tabs - | Spaces2 - | Spaces3 - | Spaces4 - deriving (Show, Eq, Ord) - +data Spacing = Tabs | Spaces2 | Spaces3 | Spaces4 + deriving (Eq, Ord, Show) toSpacing :: String -> Spacing toSpacing "tabs" = Tabs @@ -84,44 +80,30 @@ fromSpacing Spaces2 = "spaces2" fromSpacing Spaces3 = "spaces3" fromSpacing Spaces4 = "spaces4" - data LangConfiguration - = Python PythonConfig.LangConf + = EmptyConfig + | Python PythonConfig.LangConf | Haskell HaskellConfig.LangConf | Elm ElmConfig.LangConf | Gleam GleamConfig.LangConf - parseTableAsNEList :: Toml.TomlCodec (Map.Map Text LangConfiguration) - -- This comment is for testing with regular lists - -- -> Toml.TomlCodec [LangConfiguration] -> Toml.TomlCodec (NE.NonEmpty LangConfiguration) parseTableAsNEList = Toml.dimap - -- These comments are for testing with regular lists - -- (\ls -> - -- List.map - -- (\a -> (langNameString a, a)) ls - -- |> Map.fromList - -- ) - -- (\mp -> - -- Map.toList mp - -- |> List.map Pair.second - -- ) - (\ne -> - NE.toList ne - |> List.map + ( NE.toList + .> List.map (\a -> (langNameString a, a)) - |> Map.fromList + .> Map.fromList ) - (\mp -> - Map.toList mp - |> List.map Pair.second - |> UnsafeNE.fromList + ( Map.toList + .> List.map Pair.second + .> NE.fromList + .> Maybe.withDefault + (EmptyConfig :| []) ) - langNameString :: LangConfiguration -> Text langNameString (Python _) = "python" langNameString (Haskell _) = "haskell" @@ -144,7 +126,6 @@ matchGleam :: LangConfiguration -> Maybe GleamConfig.LangConf matchGleam (Gleam cnf) = Just cnf matchGleam _ = Nothing - indvLangCodec :: Toml.Key -> Toml.TomlCodec LangConfiguration indvLangCodec "python" = Toml.dimatch matchPython Python (Toml.table PythonToml.confCodec "python") @@ -155,7 +136,6 @@ indvLangCodec "gleam" = indvLangCodec "elm" = Toml.dimatch matchElm Elm (Toml.table ElmToml.confCodec "elm") - runLangWriter :: LangConfiguration -> (FilePath -> [(FilePath, [PT.DataTypes])] -> IO ()) runLangWriter (Python cnf) = PythonConfig.langWriter cnf cnf runLangWriter (Haskell cnf) = HaskellConfig.langWriter cnf cnf diff --git a/app/DataTypeTool/Config/Extras.hs b/app/DataTypeTool/Config/Extras.hs new file mode 100644 index 0000000..f3b98aa --- /dev/null +++ b/app/DataTypeTool/Config/Extras.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE + OverloadedStrings + #-} + +module DataTypeTool.Config.Extras where + +import qualified Antelude.List as List + +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text +import qualified Data.Version as Version + +import Text.Read ( readMaybe ) + +import Toml ( (.=) ) +import qualified Toml + +versionCodec :: Toml.Key -> Toml.TomlCodec Version.Version +versionCodec key = + let splitByDot :: String -> [String] + splitByDot str = case List.dropWhile (== '.') str of + "" -> [] + str' -> w : splitByDot str'' + where + (w, str'') = List.break (== '.') str' + + strToVersion :: String -> Version.Version + strToVersion str = + str + |> splitByDot + |> List.map + ( \s -> + (readMaybe s :: Maybe Int) + |> \case + Just a -> a + Nothing -> 0 + ) + |> Version.makeVersion + in Toml.dimap + Version.showVersion + strToVersion + (Toml.string key) + +optionalTextConsiderBlanks :: Toml.Key -> Toml.TomlCodec (Maybe Text) +optionalTextConsiderBlanks key = Toml.dioptional (Toml.text key) |> considerBlankAsNothing + where + considerJustBlank :: Maybe Text -> Maybe Text + considerJustBlank (Nothing) = Nothing + considerJustBlank (Just "") = Nothing + considerJustBlank (Just s) = Just s + + considerBlankAsNothing :: Toml.TomlCodec (Maybe Text) -> Toml.TomlCodec (Maybe Text) + considerBlankAsNothing = + Toml.dimap + considerJustBlank + considerJustBlank diff --git a/app/DataTypeTool/Lang/DTT/Config.hs b/app/DataTypeTool/Lang/DTT/Config.hs new file mode 100644 index 0000000..e8d5b6a --- /dev/null +++ b/app/DataTypeTool/Lang/DTT/Config.hs @@ -0,0 +1,23 @@ +module DataTypeTool.Lang.DTT.Config where + +import Data.Version ( Version ) + +import DataTypeTool.Parsing.Types ( DataTypes ) + +import Paths_datatypetool ( version ) + +data LangConf + = LangConf + { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () + , outputLocation :: FilePath + , langVersion :: Version + } + deriving (Show) + +defaultConf :: LangConf +defaultConf = + LangConf + { langWriter = \_ _ _ -> return () + , outputLocation = "." + , langVersion = version + } diff --git a/app/DataTypeTool/Lang/DTT/Default.hs b/app/DataTypeTool/Lang/DTT/Default.hs new file mode 100644 index 0000000..127b849 --- /dev/null +++ b/app/DataTypeTool/Lang/DTT/Default.hs @@ -0,0 +1,97 @@ +module DataTypeTool.Lang.DTT.Default where + +import DataTypeTool.Config.Config ( Spacing (..) ) +import DataTypeTool.Lang.DTT.Config ( LangConf (..) ) + +newToml :: String +newToml = + "[datatypetool]\n" + <> "\n" + <> "# Where are the types defined relative to this file?\n" + <> "sources = \"types\"\n" + <> "\n" + <> "# How many spaces are an indent?\n" + <> "# Can be \"spaces2\", \"spaces3\", \"spaces4\", or \"tabs\"\n" + <> "spacing = \"spaces4\"\n" + <> "\n" + <> "[targets]" + <> "\n" + <> "# All 'targets' have \"output_location\" and \"lang_version\" as common, required options" + <> "# You define your output languages here like the following:\n" + <> "# [targets.haskell]\n" + <> "# output_location = \"app\"\n" + <> "# lang_version = \"9.8.1\"\n" + <> "#\n" + <> "# Some languages have extra configuration options\n" + <> "# Please check the wiki for what can be configured\n" + +defaultTypes :: Spacing -> String +defaultTypes spacing = + let tab :: String + tab = case spacing of + Tabs -> "\t" + Spaces2 -> " " + Spaces3 -> " " + Spaces4 -> " " + in "# A wiki to get you started:" + <> "# TODO: Add wiki" + <> "\n" + <> "model People:\n" + <> tab + <> "fields:\n" + <> tab + <> tab + <> "field First_Name:\n" + <> tab + <> tab + <> tab + <> "type:\n" + <> tab + <> tab + <> tab + <> tab + <> "Str\n" + <> tab + <> tab + <> "field Last_Name:\n" + <> tab + <> tab + <> tab + <> "type:\n" + <> tab + <> tab + <> tab + <> tab + <> "Str\n" + <> tab + <> tab + <> "field Age:\n" + <> tab + <> tab + <> tab + <> "type:\n" + <> tab + <> tab + <> tab + <> tab + <> "Int\n" + <> "\n" + <> "enum Answers:\n" + <> tab + <> "members:\n" + <> tab + <> tab + <> "Yes\n" + <> tab + <> tab + <> "No\n" + <> tab + <> tab + <> "Unsure\n" + <> "\n" + <> "alias Point:\n" + <> tab + <> "type:\n" + <> tab + <> tab + <> "Tuple2 Float Float\n" diff --git a/app/DataTypeTool/Lang/Elm/Config.hs b/app/DataTypeTool/Lang/Elm/Config.hs new file mode 100644 index 0000000..fa5454e --- /dev/null +++ b/app/DataTypeTool/Lang/Elm/Config.hs @@ -0,0 +1,13 @@ +module DataTypeTool.Lang.Elm.Config where + +import Data.Version ( Version ) + +import DataTypeTool.Parsing.Types ( DataTypes ) + +data LangConf + = LangConf + { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () + , outputLocation :: FilePath + , langVersion :: Version + } + deriving (Show) diff --git a/app/DataTypeTool/Lang/Elm/Models.hs b/app/DataTypeTool/Lang/Elm/Models.hs new file mode 100644 index 0000000..e039a3c --- /dev/null +++ b/app/DataTypeTool/Lang/Elm/Models.hs @@ -0,0 +1,77 @@ +module DataTypeTool.Lang.Elm.Models where + + +{- + Elm "Alias" + + type alias SomeAlias = (String, Bool) + + "type alias " + <> pascalCase typeName + <> " = " + <> alias +-} + + +{- + Elm "Enums" + + type SomeEnum + = MemA + | MemB + | MemC + + "type " + <> pascalCase typeName + <> "\n" + <> tab + <> "= " + <> ( fmap PascalCase members + |> intersperse ("\n" <> tab <> "| ") + |> join + ) +-} + + +{- + Elm "Models" + + type alias SomeModel = + { fieldA : String + , fieldB : Int + } + + "type alias " + <> pascalCase typeName + <> " =\n" + <> tab + <> "{ " + <> ( fmap + (\(fName, fType) -> + camelCase fName + <> " : " + <> PascalCase fType + ) + fields + |> intersperse ("\n" <> tab <> ", ") + |> join + ) + <> tab + <> "}" +-} + + +{- + Elm "Constants" + + someConstant : String + someConstant = "A Value" + + camelCase typeName + <> " : " + <> pascalCase typeType + <> "\n" + <> camelCase typeName + <> " = " + <> typeVal +-} diff --git a/app/DataTypeTool/Lang/Elm/Toml.hs b/app/DataTypeTool/Lang/Elm/Toml.hs new file mode 100644 index 0000000..4c774ad --- /dev/null +++ b/app/DataTypeTool/Lang/Elm/Toml.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE + OverloadedStrings + #-} + +module DataTypeTool.Lang.Elm.Toml where + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Elm.Config ( LangConf (..) ) +import DataTypeTool.Lang.Elm.Writer ( elmWriter ) + +import Toml ( (.=) ) +import qualified Toml + +confCodec :: Toml.TomlCodec LangConf +confCodec = + LangConf + <$> (pure elmWriter) + <*> Toml.string "output_location" .= outputLocation + <*> Extras.versionCodec "lang_version" .= langVersion diff --git a/app/DataTypeTool/Lang/Elm/Versions/ElmZeroNineteenOne.hs b/app/DataTypeTool/Lang/Elm/Versions/ElmZeroNineteenOne.hs new file mode 100644 index 0000000..f9080dc --- /dev/null +++ b/app/DataTypeTool/Lang/Elm/Versions/ElmZeroNineteenOne.hs @@ -0,0 +1,573 @@ +module DataTypeTool.Lang.Elm.Versions.ElmZeroNineteenOne + ( writer + ) where + +import qualified Antelude.File as File +import qualified Antelude.List as List +import qualified Antelude.Maybe as Maybe + +import qualified Control.Monad as Monad + +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Elm.Config ( LangConf (..) ) +import qualified DataTypeTool.Parsing.Types as PT + +import qualified System.Directory as Dir + +import qualified Text.Casing as Case + +writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +writer elmConf baseDir = + let path :: FilePath -> FilePath + path pth = (baseDir <> outputLocation elmConf <> elmDirPath pth) + in Monad.mapM_ + ( \(pth, lstType) -> + Com.createWritePath + ( baseDir + <> outputLocation elmConf + <> "/DTT/" + <> elmDirPath pth + ) + >> File.writeFile + ( baseDir + <> outputLocation elmConf + <> "/DTT/" + <> elmFilePath pth + ) + ( header pth + <> staticImports + <> mapReferencedImports (pth, lstType) + <> "\n\n" + <> typesWriter lstType + ) + ) + +elmDirPath :: FilePath -> FilePath +elmDirPath = + Com.typeFilePathToLangDirPath + Com.PascalCase + +elmFilePath :: FilePath -> FilePath +elmFilePath = + Com.typeFilePathToLangFilePath + Com.PascalCase + ".elm" + +elmCodePath :: FilePath -> String +elmCodePath = + Com.typeFilePathToLangCodePath + Com.PascalCase + '.' + +header :: FilePath -> String +header fp = + "module DTT." + <> elmCodePath fp + <> " exposing (..)" + <> "\n\n{- This file was generated by DataTypeTool -}\n\n" + +staticImports :: String +staticImports = + "import Dict exposing (Dict)\n" + <> "import Set exposing (Set)\n" + <> "import Json.Decode as JD\n" + <> "import Json.Encode as JE\n" + <> "import Json.Decode.Extra as JDE\n" + <> "import Json.Encode.Extra as JEE\n" + <> "import Json.Decode.Pipeline as JDP\n" + +mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String +mapReferencedImports (_, lstDtaTypes) = + let referencedImports :: [(FilePath, [PT.Types])] -> String + referencedImports metaStuff = + ( List.map + ( \(fp, lstTypes) -> + "import DTT." + <> elmCodePath fp + <> " exposing (" + <> ( lstTypes + |> List.filter + ( \case + PT.DefinedDataType _ -> True + _ -> False + ) + |> List.map + ( \a -> + typesMap a + -- TODO, need to adjust how "DefinedDataType" are stored + -- So I can disambiguate between needing (..) or not here. + <> ", " + <> serializerMap a + <> ", " + <> deserializerMap a + ) + |> List.intersperse ", " + |> List.concat + ) + <> ")" + ) + metaStuff + |> List.intersperse "\n" + |> List.concat + ) + <> "\n" + in List.map + ( \dtaType -> + case dtaType of + PT.Alias _ meta _ -> meta + PT.Enum _ meta _ -> meta + PT.Model _ meta _ -> meta + PT.Constant _ meta _ _ -> meta + |> \case + Just m -> + Maybe.map referencedImports (PT.metaRef m) + |> Maybe.withDefault "" + Nothing -> "" + ) + lstDtaTypes + |> List.filter (/= "") + |> List.intersperse "\n" + |> List.concat + +docComments :: Maybe PT.MetaField -> String +docComments = \case + Just meta -> + case PT.metaDoc meta of + Just doc -> + "{-\n " + <> ( List.lines (Text.unpack doc) + |> List.filter (/= "") + |> List.intersperse "\n " + |> List.concat + ) + <> "\n-}\n" + Nothing -> "" + Nothing -> "" + +-- serializer :: PT.DataTypes -> String +-- serializer (PT.Constant name meta type_ value) = "" +-- serializer (PT.Alias name meta type_) = +-- ( (Text.unpack name |> Case.camel) +-- <> "Encoder : " +-- <> (Text.unpack name |> Case.pascal) +-- <> " -> JE.Value\n" +-- <> (Text.unpack name |> Case.camel) +-- <> "Encoder val =\n " +-- <> (serializerMap type_) +-- <> " val" +-- ) +-- serializer (PT.Enum name meta members) = +-- ( (Text.unpack name |> Case.camel) +-- <> "Encoder : " +-- <> (Text.unpack name |> Case.pascal) +-- <> " -> JE.Value\n" +-- <> (Text.unpack name |> Case.camel) +-- <> "Encoder val =\n " +-- <> "case val of\n " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( (Text.unpack txt) +-- <> " -> JE.string \"" +-- <> (Case.quietSnake <| Text.unpack txt) +-- <> "\"" +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- ) +-- serializer (PT.Model name meta fields) = +-- ( (Text.unpack name |> Case.camel) +-- <> "Encoder : " +-- <> (Text.unpack name |> Case.pascal) +-- <> " -> JE.Value\n" +-- <> (Text.unpack name |> Case.camel) +-- <> "Encoder val =" +-- <> "\n " +-- <> "JE.object\n [ " +-- <> ( List.map +-- (\field -> +-- ( "( \"" +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "\", " +-- <> (PT.fieldType field |> serializerMap) +-- <> " val." +-- <> (PT.fieldName field |> Text.unpack |> Case.camel) +-- <> ")" +-- ) +-- ) +-- fields +-- |> List.intersperse "\n , " +-- |> List.concat +-- ) +-- <> "\n ]" +-- ) + +-- deserializer :: PT.DataTypes -> String +-- deserializer (PT.Constant name meta type_ value) = "" +-- deserializer (PT.Alias name meta type_) = +-- ( (Text.unpack name |> Case.camel) +-- <> "Decoder : JD.Decoder " +-- <> (Text.unpack name |> Case.pascal) +-- <> "\n" +-- <> (Text.unpack name |> Case.camel) +-- <> "Decoder = " +-- <> (deserializerMap type_) +-- ) +-- deserializer (PT.Enum name meta members) = +-- ( (Text.unpack name |> Case.camel) +-- <> "Decoder : JD.Decoder " +-- <> (Text.unpack name |> Case.pascal) +-- <> "\n" +-- <> (Text.unpack name |> Case.camel) +-- <> "Decoder = JD.string" +-- <> "\n |> JD.andThen" +-- <> "\n (\\strEnum -> case strEnum of" +-- <> "\n " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( "\"" +-- <> (Case.quietSnake <| Text.unpack txt) +-- <> "\" -> JD.succeed " +-- <> (Text.unpack txt) +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- <> "\n _ -> JD.fail \"Could not find matching string for type " +-- <> (Text.unpack name |> Case.pascal) +-- <> "\"\n )" +-- ) +-- deserializer (PT.Model name meta fields) = +-- ( (Text.unpack name |> Case.camel) +-- <> "Decoder : JD.Decoder " +-- <> (Text.unpack name |> Case.pascal) +-- <> "\n" +-- <> (Text.unpack name |> Case.camel) +-- <> "Decoder =\n JD.succeed " +-- <> (Text.unpack name |> Case.pascal) +-- <> "\n " +-- <> ( List.map +-- (\field -> +-- ( "|> JDP.required \"" +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "\" (" +-- <> (PT.fieldType field |> deserializerMap) +-- <> ")" +-- ) +-- ) +-- fields +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- ) + +invTypeWriter :: PT.DataTypes -> String +invTypeWriter (PT.Constant name meta type_ value) = + docComments meta + <> (Text.unpack name |> Case.camel) + <> " : " + <> typesMap type_ + <> "\n" + <> (Text.unpack name |> Case.camel) + <> " = " + <> valuesMap value +invTypeWriter (PT.Alias name meta type_) = + docComments meta + <> "type alias " + <> (Text.unpack name |> Case.pascal) + <> " = " + <> typesMap type_ + <> "\n\n\n" + -- <> serializer (PT.Alias name meta type_) + <> "\n\n\n" +-- <> deserializer (PT.Alias name meta type_) + +invTypeWriter (PT.Enum name meta members) = + docComments meta + <> "type " + <> (Text.unpack name |> Case.pascal) + <> "\n = " + <> ( members + |> List.map (\m -> valuesMap m |> Case.pascal) + |> List.intersperse "\n | " + |> List.concat + ) + <> "\n\n\n" + -- <> serializer (PT.Enum name meta members) + <> "\n\n\n" +-- <> deserializer (PT.Enum name meta members) + +invTypeWriter (PT.Model name meta fields) = + docComments meta + <> "type alias " + <> (Text.unpack name |> Case.pascal) + <> " =\n" + <> " { " + <> ( fields + |> List.map + ( \f -> + (Text.unpack (PT.fieldName f) |> Case.camel) + <> " : " + <> typesMap (PT.fieldType f) + ) + |> List.intersperse "\n , " + |> List.concat + ) + <> "\n }" + <> "\n\n\n" + -- <> serializer (PT.Model name meta fields) + <> "\n\n\n" + +-- <> deserializer (PT.Model name meta fields) + +typesWriter :: [PT.DataTypes] -> String +typesWriter types = + List.map invTypeWriter types + |> List.intersperse "\n\n\n" + |> List.concat + +typesMap :: PT.Types -> String +typesMap = \case + PT.DTTStr -> "String" + PT.DTTInt -> "Int" + PT.DTTFloat -> "Float" + PT.DTTBool -> "Bool" + PT.DTTList a -> "List " <> typesMap a + PT.DTTDict b -> "Dict String " <> typesMap b + PT.DTTNullable a -> "Maybe " <> typesMap a + PT.DTTSet a -> "Set " <> typesMap a + PT.DTTPair a b -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ")" + PT.DTTTrio a b c -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ")" + PT.DTTQuad a b c d -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ")" + PT.DTTQuint a b c d e -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ", " + <> typesMap e + <> ")" + PT.DefinedDataType t -> Text.unpack t |> Case.pascal + +valuesMap :: PT.Values -> String +valuesMap = \case + PT.VStr str -> "\"" <> str <> "\"" + PT.VInt int -> show int + PT.VFloat flt -> show flt + PT.VBool bl -> show bl + PT.VList lst -> + "[" + <> ( List.map valuesMap lst + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VDict map -> + "Dict.fromList [" + <> ( List.map + ( \(k, v) -> + "(\"" + <> k + <> "\", " + <> valuesMap v + <> ")" + ) + (Map.toList map) + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VNullable nll -> case nll of + Just j -> "Just " <> valuesMap j + Nothing -> "Nothing" + PT.VSet set -> + "Set.fromList [" + <> ( List.map valuesMap (Set.toList set) + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VTuple2 (a, b) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ")" + PT.VTuple3 (a, b, c) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ")" + PT.VTuple4 (a, b, c, d) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ")" + PT.VTuple5 (a, b, c, d, e) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ", " + <> valuesMap e + <> ")" + PT.OtherValue t -> Text.unpack t |> Case.pascal + +serializerMap :: PT.Types -> String +serializerMap = \case + PT.DTTStr -> "(JE.string)" + PT.DTTInt -> "(JE.int)" + PT.DTTFloat -> "(JE.float)" + PT.DTTBool -> "(JE.bool)" + PT.DTTList a -> "(JE.list (" <> serializerMap a <> "))" + PT.DTTDict v -> "(JE.dict identity (" <> serializerMap v <> "))" + PT.DTTNullable a -> "(JEE.maybe (" <> serializerMap a <> "))" + PT.DTTSet a -> + "(\\a -> JE.object [(\"set\", " + <> serializerMap a + <> "(Set.fromList a))) " + PT.DTTPair a b -> + "(\\(a, b) -> JE.object [(\"first\", " + <> serializerMap a + <> " a), (\"second\", " + <> serializerMap b + <> " b)])" + PT.DTTTrio a b c -> + "(\\(a, b, c) -> JE.object [(\"first\", " + <> serializerMap a + <> " a), (\"second\", " + <> serializerMap b + <> " b), (\"third\", " + <> serializerMap c + <> " c)])" + PT.DTTQuad a b c d -> + "(\\(a, b, c, d) -> JE.object [(\"first\", " + <> serializerMap a + <> " a), (\"second\", " + <> serializerMap b + <> " b), (\"third\", " + <> serializerMap c + <> " c), (\"fourth\", " + <> serializerMap d + <> " d)])" + PT.DTTQuint a b c d e -> + "(\\(a, b, c, d, e) -> JE.object [(\"first\", " + <> serializerMap a + <> " a), (\"second\", " + <> serializerMap b + <> " b), (\"third\", " + <> serializerMap c + <> " c), (\"fourth\", " + <> serializerMap d + <> " d), (\"fifth\", " + <> serializerMap e + <> " e)])" + PT.DefinedDataType txt -> Text.unpack txt |> Case.camel |> (<> "Encoder") + +deserializerMap :: PT.Types -> String +deserializerMap = \case + PT.DTTStr -> "(JD.string)" + PT.DTTInt -> "(JD.int)" + PT.DTTFloat -> "(JD.float)" + PT.DTTBool -> "(JD.bool)" + PT.DTTList a -> "(JD.list (" <> deserializerMap a <> "))" + PT.DTTDict v -> "(JD.dict (" <> deserializerMap v <> "))" + PT.DTTNullable a -> "(JD.nullable " <> deserializerMap a <> ")" + PT.DTTSet a -> + "(JD.map Set.fromList" + <> " (JD.field \"set\" (JD.list (" + <> deserializerMap a + <> "))))" + PT.DTTPair a b -> + "(JD.map2 (\\a b -> (a, b))" + <> " (JD.field \"first\" (" + <> deserializerMap a + <> ")) (JD.field \"second\" (" + <> deserializerMap b + <> ")))" + PT.DTTTrio a b c -> + "(JD.map3 (\\a b c -> (a, b, c))" + <> " (JD.field \"first\" (" + <> deserializerMap a + <> ")) (JD.field \"second\" (" + <> deserializerMap b + <> ")) (JD.field \"third\" (" + <> deserializerMap c + <> ")))" + PT.DTTQuad a b c d -> + "(JD.map4 (\\a b c d -> (a, b, c, d))" + <> " (JD.field \"first\" (" + <> deserializerMap a + <> ")) (JD.field \"second\" (" + <> deserializerMap b + <> ")) (JD.field \"third\" (" + <> deserializerMap c + <> ")) (JD.field \"fourth\" (" + <> deserializerMap d + <> ")))" + PT.DTTQuint a b c d e -> + "(JD.map5 (\\a b c d e -> (a, b, c, d, e))" + <> " (JD.field \"first\" (" + <> deserializerMap a + <> ")) (JD.field \"second\" (" + <> deserializerMap b + <> ")) (JD.field \"third\" (" + <> deserializerMap c + <> ")) (JD.field \"fourth\" (" + <> deserializerMap d + <> ")) (JD.field \"fifth\" (" + <> deserializerMap e + <> ")))" + PT.DefinedDataType txt -> Text.unpack txt |> Case.camel |> (<> "Decoder") diff --git a/app/DataTypeTool/Lang/Elm/Writer.hs b/app/DataTypeTool/Lang/Elm/Writer.hs new file mode 100644 index 0000000..041d43e --- /dev/null +++ b/app/DataTypeTool/Lang/Elm/Writer.hs @@ -0,0 +1,22 @@ +module DataTypeTool.Lang.Elm.Writer where + +import Data.Version + ( Version + , makeVersion + , showVersion + ) + +import qualified DataTypeTool.Common.Utils as Com +import DataTypeTool.Lang.Elm.Config + ( LangConf (..) + ) +import qualified DataTypeTool.Lang.Elm.Versions.ElmZeroNineteenOne as E0_19_1 +import qualified DataTypeTool.Parsing.Types as PT + +elmWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +elmWriter langConf path typeData = + let elmV = langVersion langConf + in if + | elmV >= makeVersion [0, 19, 0] -> E0_19_1.writer langConf path typeData + | otherwise -> + print ("Unable to make out the correct writer for the specified Elm version" <> showVersion elmV) diff --git a/app/DataTypeTool/Lang/Gleam/Config.hs b/app/DataTypeTool/Lang/Gleam/Config.hs new file mode 100644 index 0000000..9de9316 --- /dev/null +++ b/app/DataTypeTool/Lang/Gleam/Config.hs @@ -0,0 +1,17 @@ +module DataTypeTool.Lang.Gleam.Config where + +import Data.Version ( Version ) + +import DataTypeTool.Parsing.Types ( DataTypes ) + +data GleamBackend = GleamErlang | GleamJS + deriving (Eq, Ord, Show) + +data LangConf + = LangConf + { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () + , outputLocation :: FilePath + , langVersion :: Version + , preferredBackend :: GleamBackend + } + deriving (Show) diff --git a/app/DataTypeTool/Lang/Gleam/Models.hs b/app/DataTypeTool/Lang/Gleam/Models.hs new file mode 100644 index 0000000..43fcdd4 --- /dev/null +++ b/app/DataTypeTool/Lang/Gleam/Models.hs @@ -0,0 +1,38 @@ +module DataTypeTool.Lang.Gleam.Models where + + +{- + Gleam "Alias" + + pub type SomeAlias = #(String, Bool) +-} + + +{- + Gleam "Enums" + + pub type SomeEnum { + MemA + MemB + MemC + } +-} + + +{- + Gleam "Models" + + pub type SomeModel { + SomeModel( + fieldA: String, + fieldB: Int + ) + } +-} + + +{- + Gleam "Constants" + + const some_constant: String = "A Value" +-} diff --git a/app/DataTypeTool/Lang/Gleam/Toml.hs b/app/DataTypeTool/Lang/Gleam/Toml.hs new file mode 100644 index 0000000..cd9beb7 --- /dev/null +++ b/app/DataTypeTool/Lang/Gleam/Toml.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE + OverloadedStrings + #-} + +module DataTypeTool.Lang.Gleam.Toml where + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Gleam.Config + ( GleamBackend (..) + , LangConf (..) + ) +import DataTypeTool.Lang.Gleam.Writer ( gleamWriter ) + +import Toml ( (.=) ) +import qualified Toml + +backendCodec :: Toml.Key -> Toml.TomlCodec GleamBackend +backendCodec key = + let strToBackend :: String -> GleamBackend + strToBackend ("erlang") = GleamErlang + strToBackend ("javascript") = GleamJS + + backendToStr :: GleamBackend -> String + backendToStr (GleamErlang) = "erlang" + backendToStr (GleamJS) = "javascript" + in Toml.dimap + backendToStr + strToBackend + (Toml.string key) + +confCodec :: Toml.TomlCodec LangConf +confCodec = + LangConf + <$> pure gleamWriter + <*> Toml.string "output_location" .= outputLocation + <*> Extras.versionCodec "lang_version" .= langVersion + <*> backendCodec "preferred_backend" .= preferredBackend diff --git a/app/DataTypeTool/Lang/Gleam/Versions/GleamOneZeroZero.hs b/app/DataTypeTool/Lang/Gleam/Versions/GleamOneZeroZero.hs new file mode 100644 index 0000000..756435c --- /dev/null +++ b/app/DataTypeTool/Lang/Gleam/Versions/GleamOneZeroZero.hs @@ -0,0 +1,631 @@ +module DataTypeTool.Lang.Gleam.Versions.GleamOneZeroZero + ( writer + ) where + +import qualified Antelude.File as File +import qualified Antelude.List as List +import qualified Antelude.Maybe as Maybe + +import qualified Control.Monad as Monad + +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Gleam.Config ( LangConf (..) ) +import qualified DataTypeTool.Parsing.Types as PT + +import qualified System.Directory as Dir + +import qualified Text.Casing as Case + +writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +writer gleamConf baseDir = + let path :: FilePath -> FilePath + path pth = (baseDir <> outputLocation gleamConf <> gleamDirPath pth) + in Monad.mapM_ + ( \(pth, lstType) -> + Dir.createDirectoryIfMissing + True + ( baseDir + <> outputLocation gleamConf + <> "/dtt/" + <> gleamDirPath pth + ) + >> File.writeFile + ( baseDir + <> outputLocation gleamConf + <> "/dtt/" + <> gleamFilePath pth + ) + ( header + <> staticImports + <> mapReferencedImports (pth, lstType) + <> "\n\n" + <> ( List.map + invTypeWriter + lstType + |> List.intersperse "\n\n\n" + |> List.concat + ) + ) + ) + +gleamDirPath :: FilePath -> FilePath +gleamDirPath = + Com.typeFilePathToLangDirPath + Com.QuietSnakeCase + +gleamFilePath :: FilePath -> FilePath +gleamFilePath = + Com.typeFilePathToLangFilePath + Com.QuietSnakeCase + ".gleam" + +-- for the header of files, imports, etc +gleamCodePath :: FilePath -> String +gleamCodePath = + Com.typeFilePathToLangCodePath + Com.QuietSnakeCase + '/' + +header :: String +header = + "//// This file was generated by DataTypeTool\n\n" + +staticImports :: String +staticImports = + "import gleam/dict.{type Dict}\n" + <> "import gleam/set.{type Set}\n" + <> "import gleam/dynamic.{type Dynamic, type DecodeError}\n" + <> "import gleam/json.{type Json}\n" + <> "import gleam/option.{type Option}\n" + <> "import gleam/result.{try}\n" + +mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String +mapReferencedImports (_, lstDtaTypes) = + let referencedImports :: [(FilePath, [PT.Types])] -> String + referencedImports metaStuff = + ( List.map + ( \(fp, lstTypes) -> + "import dtt/" + <> gleamCodePath fp + <> ".{" + <> ( lstTypes + |> List.map + ( \case + PT.DefinedDataType txt -> + "type " + <> (typesMap <| PT.DefinedDataType txt) + <> ", " + <> (txt |> Text.unpack |> Case.quietSnake) + <> "_encoder, " + <> (deserializerMap <| PT.DefinedDataType txt) + _ -> "" + ) + |> List.filter (/= "") + |> List.intersperse ", " + |> List.concat + ) + <> "}" + ) + metaStuff + |> List.intersperse "\n" + |> List.concat + ) + <> "\n" + in List.map + ( \dtaType -> + case dtaType of + PT.Alias _ meta _ -> meta + PT.Enum _ meta _ -> meta + PT.Model _ meta _ -> meta + PT.Constant _ meta _ _ -> meta + |> \case + Just m -> + Maybe.map referencedImports (PT.metaRef m) + |> Maybe.withDefault "" + Nothing -> "" + ) + lstDtaTypes + |> List.filter (/= "") + |> List.intersperse "\n" + |> List.concat + +docComments :: Maybe PT.MetaField -> String +docComments = \case + Just meta -> + case PT.metaDoc meta of + Just doc -> + "/// " + <> ( List.lines (Text.unpack doc) + |> List.filter (/= "") + |> List.intersperse "\n/// " + |> List.concat + ) + <> "\n" + Nothing -> "" + Nothing -> "" + +-- serializer :: PT.DataTypes -> String +-- serializer (PT.Constant name meta type_ value) = "" +-- serializer (PT.Alias name meta type_) = +-- "pub fn " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_encoder(" +-- <> (Text.unpack name |> Case.quietSnake) +-- <> ": " +-- <> (Text.unpack name |> Case.pascal) +-- <> ") -> Json {" +-- <> "\n " +-- <> (serializerMap type_) +-- <> "(" +-- <> (Text.unpack name |> Case.quietSnake) +-- <> ")" +-- <> "\n}" +-- serializer (PT.Enum name meta members) = +-- "pub fn " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_encoder(" +-- <> (Text.unpack name |> Case.quietSnake) +-- <> ": " +-- <> (Text.unpack name |> Case.pascal) +-- <> ") -> Json {" +-- <> "\n case " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> " {\n " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( (Text.unpack txt |> Case.pascal) +-- <> " -> json.string(\"" +-- <> (Text.unpack txt |> Case.quietSnake) +-- <> "\")" +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- <> "\n }" +-- <> "\n}" +-- serializer (PT.Model name meta fields) = +-- "pub fn " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_encoder(" +-- <> (Text.unpack name |> Case.quietSnake) +-- <> ": " +-- <> (Text.unpack name |> Case.pascal) +-- <> ") -> Json {" +-- <> "\n json.object([" +-- <> "\n " +-- <> ( List.map +-- (\field -> +-- ( "#(\"" +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "\", " +-- <> (PT.fieldType field |> serializerMap) +-- <> "(" +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "." +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "))" +-- ) +-- ) +-- fields +-- |> List.intersperse ",\n " +-- |> List.concat +-- ) +-- <> "\n ])" +-- <> "\n}" + +-- deserializer :: PT.DataTypes -> String +-- deserializer (PT.Constant name meta type_ value) = "" +-- deserializer (PT.Alias name meta type_) = +-- "pub fn " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_decoder(json: Dynamic) -> Result(" +-- <> (Text.unpack name |> Case.pascal) +-- <> ", List(DecodeError)) {" +-- <> "\n " +-- <> (deserializerMap type_) +-- <> "(json)\n}" +-- deserializer (PT.Enum name meta members) = +-- "pub fn " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_decoder(json: Dynamic) -> Result(" +-- <> (Text.unpack name |> Case.pascal) +-- <> ", List(DecodeError)) {" +-- <> "\n use enum_str <- result.try(dynamic.string(json))" +-- <> "\n case enum_str {" +-- <> "\n " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( "\"" +-- <> (Text.unpack txt |> Case.quietSnake) +-- <> "\" -> Ok(" +-- <> (Text.unpack txt |> Case.pascal) +-- <> ")" +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- <> "\n err -> Error(" +-- <> "\n [dynamic.DecodeError(" +-- <> "\n \"Expected one of: " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( "\\\"" +-- <> (Text.unpack txt |> Case.quietSnake) +-- <> "\\\"" +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse ", " +-- |> List.concat +-- ) +-- <> "\"," +-- <> "\n \"Found: \" <> err," +-- <> "\n []" +-- <> "\n )]" +-- <> "\n )" +-- <> "\n }" +-- <> "\n}" +-- deserializer (PT.Model name meta fields) = +-- "pub fn " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_decoder(json: Dynamic) -> Result(" +-- <> (Text.unpack name |> Case.pascal) +-- <> ", List(DecodeError)) {" +-- <> ( List.map +-- (\field -> +-- ( "\n use " +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> " <- try(dynamic.field(\"" +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "\", " +-- <> (PT.fieldType field |> deserializerMap) +-- <> ")(json))" +-- ) +-- ) +-- fields +-- |> List.concat +-- ) +-- <> "\n Ok(" +-- <> (Text.unpack name |> Case.pascal) +-- <> "(" +-- <> ( List.map +-- (\field -> +-- (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- ) +-- fields +-- |> List.intersperse ", " +-- |> List.concat +-- ) +-- <> "))\n}" + +invTypeWriter :: PT.DataTypes -> String +invTypeWriter (PT.Constant name meta type_ value) = + docComments meta + <> "/// Temporarily a function solely because Dict's cant be constructed free-hand.\n" + <> "pub fn " + <> (Text.unpack name |> Case.quietSnake) + <> "() -> " + <> typesMap type_ + <> " {" + <> valuesMap value + <> "}" +-- ( docComments meta +-- <> "pub const " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> ": " +-- <> (typesMap type_) +-- <> " = " +-- <> (valuesMap value) +-- ) +invTypeWriter (PT.Alias name meta type_) = + docComments meta + <> "pub type " + <> (Text.unpack name |> Case.pascal) + <> " = " + <> typesMap type_ + <> "\n\n\n" + -- <> serializer (PT.Alias name meta type_) + <> "\n\n\n" +-- <> deserializer (PT.Alias name meta type_) +invTypeWriter (PT.Enum name meta members) = + "pub type " + <> (Text.unpack name |> Case.pascal) + <> " {\n " + <> ( members + |> List.map (\m -> valuesMap m |> Case.pascal) + |> List.intersperse "\n " + |> List.concat + ) + <> "\n}" + <> "\n\n\n" + -- <> serializer (PT.Enum name meta members) + <> "\n\n\n" +-- <> deserializer (PT.Enum name meta members) +invTypeWriter (PT.Model name meta fields) = + docComments meta + <> "pub type " + <> (Text.unpack name |> Case.pascal) + <> " {\n " + <> (Text.unpack name |> Case.pascal) + <> "(\n " + <> ( fields + |> List.map + ( \f -> + (Text.unpack (PT.fieldName f) |> Case.quietSnake) + <> ": " + <> typesMap (PT.fieldType f) + ) + |> List.intersperse ",\n " + |> List.concat + ) + <> "\n )\n}" + <> "\n\n\n" + -- <> serializer (PT.Model name meta fields) + <> "\n\n\n" + +-- <> deserializer (PT.Model name meta fields) + +typesWriter :: [PT.DataTypes] -> String +typesWriter types = + List.map invTypeWriter types + |> List.intersperse "\n\n\n" + |> List.concat + +typesMap :: PT.Types -> String +typesMap = \case + PT.DTTStr -> "String" + PT.DTTInt -> "Int" + PT.DTTFloat -> "Float" + PT.DTTBool -> "Bool" + PT.DTTList a -> "List(" <> typesMap a <> ")" + PT.DTTDict b -> "Dict(String, " <> typesMap b <> ")" + PT.DTTNullable a -> "Option(" <> typesMap a <> ")" + PT.DTTSet a -> "Set(" <> typesMap a <> ")" + PT.DTTPair a b -> + "#(" + <> typesMap a + <> ", " + <> typesMap b + <> ")" + PT.DTTTrio a b c -> + "#(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ")" + PT.DTTQuad a b c d -> + "#(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ")" + PT.DTTQuint a b c d e -> + "#(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ", " + <> typesMap e + <> ")" + PT.DefinedDataType t -> Text.unpack t |> Case.pascal + +valuesMap :: PT.Values -> String +valuesMap = \case + PT.VStr str -> "\"" <> str <> "\"" + PT.VInt int -> show int + PT.VFloat flt -> show flt + PT.VBool bl -> show bl + PT.VList lst -> + "[" + <> ( List.map valuesMap lst + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VDict map -> + -- ToDo: Dict value constructor does not exist. + "dict.from_list([" + <> ( List.map + ( \(k, v) -> + "#(\"" + <> k + <> "\", " + <> valuesMap v + <> ")" + ) + (Map.toList map) + |> List.intersperse ", " + |> List.concat + ) + <> "])" + PT.VNullable nll -> case nll of + Just j -> "Some(" <> valuesMap j <> ")" + Nothing -> "None" + PT.VSet set -> + "Set.fromList [" + <> ( List.map valuesMap (Set.toList set) + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VTuple2 (a, b) -> + "#(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ")" + PT.VTuple3 (a, b, c) -> + "#(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ")" + PT.VTuple4 (a, b, c, d) -> + "#(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ")" + PT.VTuple5 (a, b, c, d, e) -> + "#(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ", " + <> valuesMap e + <> ")" + PT.OtherValue t -> Text.unpack t |> Case.pascal + +serializerMap :: PT.Types -> String +serializerMap = \case + PT.DTTStr -> "json.string" + PT.DTTInt -> "json.int" + PT.DTTFloat -> "json.float" + PT.DTTBool -> "json.bool" + PT.DTTList a -> "fn(l){json.array(l, " <> serializerMap a <> ")}" + PT.DTTDict v -> "fn(d){json.object(dict.map_values(d, fn(_,v){" <> serializerMap v <> "(v)}) |> dict.to_list)}" + PT.DTTNullable a -> "fn(n){json.nullable(n, " <> serializerMap a <> ")}" + PT.DTTSet a -> + "fn(s){json.object([#(\"set\", json.array(set.to_list(s), " + <> serializerMap a + <> "))])}" + PT.DTTPair a b -> + "fn(t){let #(a,b) = t json.object([" + <> "#(\"first\", " + <> serializerMap a + <> "(a)), #(\"second\", " + <> serializerMap b + <> "(b))])}" + PT.DTTTrio a b c -> + "fn(t){let #(a,b,c) = t json.object([" + <> "#(\"first\", " + <> serializerMap a + <> "(a)), #(\"second\", " + <> serializerMap b + <> "(b)), #(\"third\", " + <> serializerMap c + <> "(c))])}" + PT.DTTQuad a b c d -> + "fn(t){let #(a,b,c,d) = t json.object([" + <> "#(\"first\", " + <> serializerMap a + <> "(a)), #(\"second\", " + <> serializerMap b + <> "(b)), #(\"third\", " + <> serializerMap c + <> "(c)), #(\"fourth\", " + <> serializerMap d + <> "(d))])}" + PT.DTTQuint a b c d e -> + "fn(t){let #(a,b,c,d,e) = t json.object([" + <> "#(\"first\", " + <> serializerMap a + <> "(a)), #(\"second\", " + <> serializerMap b + <> "(b)), #(\"third\", " + <> serializerMap c + <> "(c)), #(\"fourth\", " + <> serializerMap d + <> "(d)), #(\"fifth\", " + <> serializerMap e + <> "(e))])}" + PT.DefinedDataType txt -> (Text.unpack txt |> Case.quietSnake) <> "_encoder" + +deserializerMap :: PT.Types -> String +deserializerMap = \case + PT.DTTStr -> "dynamic.string" + PT.DTTInt -> "dynamic.int" + PT.DTTFloat -> "dynamic.float" + PT.DTTBool -> "dynamic.bool" + PT.DTTList a -> "dynamic.list(" <> deserializerMap a <> ")" + PT.DTTDict v -> "dynamic.dict(dynamic.string, " <> deserializerMap v <> ")" + PT.DTTNullable a -> "dynamic.optional(" <> deserializerMap a <> ")" + PT.DTTSet a -> + "fn(setjson){use s <- try(fn(s){dynamic.field(\"set\", dynamic.list(" + <> deserializerMap a + <> "))(setjson) |> result.map(set.from_list)}) Ok(s)}" + PT.DTTPair a b -> + "fn(t2json){use a <- try(dynamic.field(\"first\", " + <> deserializerMap a + <> ")(t2json))" + <> " use b <- try(dynamic.field(\"second\", " + <> deserializerMap b + <> ")(t2json)) Ok(#(a, b))}" + PT.DTTTrio a b c -> + "fn(t3json){use a <- try(dynamic.field(\"first\", " + <> deserializerMap a + <> ")(t3json))" + <> " use b <- try(dynamic.field(\"second\", " + <> deserializerMap b + <> ")(t3json))" + <> " use c <- try(dynamic.field(\"third\", " + <> deserializerMap c + <> ")(t3json)) Ok(#(a, b, c))}" + PT.DTTQuad a b c d -> + "fn(t4json){use a <- try(dynamic.field(\"first\", " + <> deserializerMap a + <> ")(t4json))" + <> " use b <- try(dynamic.field(\"second\", " + <> deserializerMap b + <> ")(t4json))" + <> " use b <- try(dynamic.field(\"third\", " + <> deserializerMap c + <> ")(t4json))" + <> " use d <- try(dynamic.field(\"fourth\", " + <> deserializerMap d + <> ")(t4json)) Ok(#(a, b, c, d))}" + PT.DTTQuint a b c d e -> + "fn(t5json){use a <- try(dynamic.field(\"first\", " + <> deserializerMap a + <> ")(t5json))" + <> " use b <- try(dynamic.field(\"second\", " + <> deserializerMap b + <> ")(t5json))" + <> " use c <- try(dynamic.field(\"third\", " + <> deserializerMap c + <> ")(t5json))" + <> " use d <- try(dynamic.field(\"fourth\", " + <> deserializerMap d + <> ")(t5json))" + <> " use e <- try(dynamic.field(\"fifth\", " + <> deserializerMap e + <> ")(t5json)) Ok(#(a, b, c, d, e))}" + PT.DefinedDataType txt -> Text.unpack txt |> Case.quietSnake |> (<> "_decoder") diff --git a/app/DataTypeTool/Lang/Gleam/Writer.hs b/app/DataTypeTool/Lang/Gleam/Writer.hs new file mode 100644 index 0000000..9d9e5a9 --- /dev/null +++ b/app/DataTypeTool/Lang/Gleam/Writer.hs @@ -0,0 +1,22 @@ +module DataTypeTool.Lang.Gleam.Writer where + +import Data.Version + ( Version + , makeVersion + , showVersion + ) + +import qualified DataTypeTool.Common.Utils as Com +import DataTypeTool.Lang.Gleam.Config + ( LangConf (..) + ) +import DataTypeTool.Lang.Gleam.Versions.GleamOneZeroZero as G1_0_0 +import qualified DataTypeTool.Parsing.Types as PT + +gleamWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +gleamWriter langConf path typeData = + let gleamV = langVersion langConf + in if + | gleamV >= makeVersion [1, 0, 0] -> G1_0_0.writer langConf path typeData + | otherwise -> + print ("Unable to make out the correct writer for the specified Gleam version: " <> showVersion gleamV) diff --git a/app/DataTypeTool/Lang/Haskell/Config.hs b/app/DataTypeTool/Lang/Haskell/Config.hs new file mode 100644 index 0000000..aa8a436 --- /dev/null +++ b/app/DataTypeTool/Lang/Haskell/Config.hs @@ -0,0 +1,14 @@ +module DataTypeTool.Lang.Haskell.Config where + +import Data.Version ( Version ) + +import DataTypeTool.Parsing.Types ( DataTypes ) + +data LangConf + = LangConf + { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () + , outputLocation :: FilePath + , langVersion :: Version + , useTextOverString :: Bool + } + deriving (Show) diff --git a/app/DataTypeTool/Lang/Haskell/Models.hs b/app/DataTypeTool/Lang/Haskell/Models.hs new file mode 100644 index 0000000..5d21f3b --- /dev/null +++ b/app/DataTypeTool/Lang/Haskell/Models.hs @@ -0,0 +1,40 @@ +module DataTypeTool.Lang.Haskell.Models where + + +{- + Haskell "Alias" + + type SomeAlias = (String, Bool) +-} + +type SomeAlias = (String, Bool) + +{- + Haskell "Enums" + + data SomeEnum + = MemA + | MemB + | MemC + deriving (Show, ...) +-} + + +{- + Haskell "Models" + + data SomeModel = + SomeModel + { fieldA : String + , fieldB : Int + } + deriving (Show, ...) +-} + + +{- + Haskell "Constants" + + someConstant :: String + someConstant = "A Value" +-} diff --git a/app/DataTypeTool/Lang/Haskell/Toml.hs b/app/DataTypeTool/Lang/Haskell/Toml.hs new file mode 100644 index 0000000..0c29d61 --- /dev/null +++ b/app/DataTypeTool/Lang/Haskell/Toml.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE + OverloadedStrings + #-} + +module DataTypeTool.Lang.Haskell.Toml where + +import qualified Data.Maybe as Maybe + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Haskell.Config ( LangConf (..) ) +import DataTypeTool.Lang.Haskell.Writer ( haskellWriter ) + +import Toml ( (.=) ) +import qualified Toml + +confCodec :: Toml.TomlCodec LangConf +confCodec = + LangConf + <$> pure haskellWriter + <*> Toml.string "output_location" .= outputLocation + <*> Extras.versionCodec "lang_version" .= langVersion + <*> ( Toml.dioptional (Toml.bool "use_text_over_string") + |> Toml.dimap + (Just) + (Maybe.fromMaybe False) + ) + .= useTextOverString diff --git a/app/DataTypeTool/Lang/Haskell/Versions/GHCNineEightOne.hs b/app/DataTypeTool/Lang/Haskell/Versions/GHCNineEightOne.hs new file mode 100644 index 0000000..4fdb2aa --- /dev/null +++ b/app/DataTypeTool/Lang/Haskell/Versions/GHCNineEightOne.hs @@ -0,0 +1,595 @@ +module DataTypeTool.Lang.Haskell.Versions.GHCNineEightOne + ( writer + ) where + +import qualified Antelude.File as File +import qualified Antelude.List as List +import qualified Antelude.Maybe as Maybe + +import qualified Control.Monad as Monad + +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Haskell.Config ( LangConf (..) ) +import qualified DataTypeTool.Parsing.Types as PT + +import qualified System.Directory as Dir + +import qualified Text.Casing as Case + +writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +writer haskellConf baseDir = + let path :: FilePath -> FilePath + path pth = (baseDir <> outputLocation haskellConf <> haskellDirPath pth) + in Monad.mapM_ + ( \(pth, lstType) -> + Com.createWritePath + ( baseDir + <> outputLocation haskellConf + <> "/DTT/" + <> haskellDirPath pth + ) + >> File.writeFile + ( baseDir + <> outputLocation haskellConf + <> "/DTT/" + <> haskellFilePath pth + ) + ( header pth + <> staticImports + <> mapReferencedImports (pth, lstType) + <> "\n\n" + <> typesWriter lstType + ) + ) + +haskellDirPath :: FilePath -> FilePath +haskellDirPath = + Com.typeFilePathToLangDirPath + Com.PascalCase + +haskellFilePath :: FilePath -> FilePath +haskellFilePath = + Com.typeFilePathToLangFilePath + Com.PascalCase + ".hs" + +haskellCodePath :: FilePath -> String +haskellCodePath = + Com.typeFilePathToLangCodePath + Com.PascalCase + '.' + +header :: FilePath -> String +header fp = + "module DTT." + <> haskellCodePath fp + <> " where" + <> "\n\n{- This file was generated by DataTypeTool -}\n\n" + +staticImports :: String +staticImports = + "import Data.Map.Strict (Map)\n" + <> "import qualified Data.Map.Strict as Map\n" + <> "import Data.Set (Set)\n" + <> "import qualified Data.Set as Set\n" + <> "import Data.String (fromString)\n" + <> "import Data.Text (Text)\n" + <> "import qualified Data.Text as Text\n" + <> "import qualified Data.Aeson as Aeson\n" + <> "import qualified Data.Aeson.Types as AesonT\n" + <> "import Data.Function ((&))\n" + <> "import Control.Applicative ((<|>))\n" + <> "import Control.Monad.Fail (fail)\n" + +mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String +mapReferencedImports (_, lstDtaTypes) = + let referencedImports :: [(FilePath, [PT.Types])] -> String + referencedImports metaStuff = + ( List.map + ( \(fp, lstTypes) -> + "import DTT." + <> haskellCodePath fp + ) + metaStuff + |> List.intersperse "\n" + |> List.concat + ) + <> "\n" + in List.map + ( \dtaType -> + case dtaType of + PT.Alias _ meta _ -> meta + PT.Enum _ meta _ -> meta + PT.Model _ meta _ -> meta + PT.Constant _ meta _ _ -> meta + |> \case + Just m -> + Maybe.map referencedImports (PT.metaRef m) + |> Maybe.withDefault "" + Nothing -> "" + ) + lstDtaTypes + |> List.filter (/= "") + |> List.intersperse "\n" + |> List.concat + +docComments :: Maybe PT.MetaField -> String +docComments = \case + Just meta -> + case PT.metaDoc meta of + Just doc -> + "{- |\n " + <> ( List.lines (Text.unpack doc) + |> List.filter (/= "") + |> List.intersperse "\n " + |> List.concat + ) + <> "\n-}\n" + Nothing -> "" + Nothing -> "" + +serializer :: PT.DataTypes -> String +serializer (PT.Constant name meta type_ value) = "" +serializer (PT.Alias name meta type_) = + (Text.unpack name |> Case.camel) + <> "Encoder :: " + <> (Text.unpack name |> Case.pascal) + <> " -> AesonT.Value\n" + <> (Text.unpack name |> Case.camel) + <> "Encoder = " + <> serializerMap type_ +serializer (PT.Enum name meta members) = + (Text.unpack name |> Case.camel) + <> "Encoder :: " + <> (Text.unpack name |> Case.pascal) + <> " -> AesonT.Value\n" + <> (Text.unpack name |> Case.camel) + <> "Encoder t = case t of\n " + <> ( List.map + ( \case + PT.OtherValue txt -> + ( Text.unpack txt + <> " -> Aeson.toJSON \"" + <> (Case.quietSnake <| Text.unpack txt) + <> "\"" + ) + _ -> "" + ) + members + |> List.filter (/= "") + |> List.intersperse "\n " + |> List.concat + ) +serializer (PT.Model name meta fields) = + (Text.unpack name |> Case.camel) + <> "Encoder :: " + <> (Text.unpack name |> Case.pascal) + <> " -> AesonT.Value\n" + <> (Text.unpack name |> Case.camel) + <> "Encoder val = Aeson.object" + <> "\n [ " + <> ( List.map + ( \field -> + "(fromString \"" + <> (Case.quietSnake <| Text.unpack <| PT.fieldName field) + <> "\" :: Aeson.Key) Aeson..= (" + <> (Text.unpack name |> Case.camel) + <> (Text.unpack (PT.fieldName field) |> Case.pascal) + <> " val |> " + <> (serializerMap <| PT.fieldType field) + <> ")" + ) + fields + |> List.intersperse "\n , " + |> List.concat + ) + <> "\n ]" + +deserializer :: PT.DataTypes -> String +deserializer (PT.Constant name meta type_ value) = "" +deserializer (PT.Alias name meta type_) = + (Text.unpack name |> Case.camel) + <> "Decoder :: " + <> "AesonT.Value -> AesonT.Parser (" + <> (Text.unpack name |> Case.pascal) + <> ")\n" + <> (Text.unpack name |> Case.camel) + <> "Decoder =\n " + <> deserializerMap type_ +deserializer (PT.Enum name meta members) = + (Text.unpack name |> Case.camel) + <> "Decoder :: " + <> "AesonT.Value -> AesonT.Parser (" + <> (Text.unpack name |> Case.pascal) + <> ")\n" + <> (Text.unpack name |> Case.camel) + <> "Decoder = Aeson.withText \"" + <> (Text.unpack name |> Case.pascal) + <> "\"\n (\\t -> Text.unpack t |> " + <> "\\a -> case a of\n " + <> ( List.map + ( \case + PT.OtherValue txt -> + ( "\"" + <> (Case.quietSnake <| Text.unpack txt) + <> "\" -> return <| " + <> Text.unpack txt + ) + _ -> "" + ) + members + |> List.filter (/= "") + |> List.intersperse "\n " + |> List.concat + ) + <> "\n _ -> fail \"Invalid string for type " + <> (Text.unpack name |> Case.pascal) + <> "\"\n )" +deserializer (PT.Model name meta fields) = + (Text.unpack name |> Case.camel) + <> "Decoder :: " + <> "AesonT.Value -> AesonT.Parser (" + <> (Text.unpack name |> Case.pascal) + <> ")\n" + <> (Text.unpack name |> Case.camel) + <> "Decoder = Aeson.withObject \"" + <> (Text.unpack name |> Case.pascal) + <> "\" <| \\value -> " + <> (Text.unpack name |> Case.pascal) + <> "\n <$> " + <> ( List.map + ( \field -> + "(value Aeson..: (fromString \"" + <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) + <> "\" :: Aeson.Key) >>= (" + <> (deserializerMap <| PT.fieldType field) + <> "))" + ) + fields + |> List.intersperse "\n <*> " + |> List.concat + ) + +invTypeWriter :: PT.DataTypes -> String +invTypeWriter (PT.Constant name meta type_ value) = + docComments meta + <> (Text.unpack name |> Case.camel) + <> " :: " + <> typesMap type_ + <> "\n" + <> (Text.unpack name |> Case.camel) + <> " = " + <> valuesMap value +invTypeWriter (PT.Alias name meta type_) = + docComments meta + <> "type " + <> (Text.unpack name |> Case.pascal) + <> " = " + <> typesMap type_ + <> "\n\n\n" + <> serializer (PT.Alias name meta type_) + <> "\n\n\n" + <> deserializer (PT.Alias name meta type_) +invTypeWriter (PT.Enum name meta members) = + docComments meta + <> "data " + <> (Text.unpack name |> Case.pascal) + <> "\n = " + <> ( members + |> List.map valuesMap + |> List.intersperse "\n | " + |> List.concat + ) + <> "\n\n\n" + <> serializer (PT.Enum name meta members) + <> "\n\n\n" + <> deserializer (PT.Enum name meta members) +invTypeWriter (PT.Model name meta fields) = + docComments meta + <> "data " + <> (Text.unpack name |> Case.pascal) + <> " = " + <> (Text.unpack name |> Case.pascal) + <> "\n" + <> " { " + <> ( fields + |> List.map + ( \f -> + (Text.unpack name |> Case.camel) + <> (Text.unpack (PT.fieldName f) |> Case.pascal) + <> " :: " + <> typesMap (PT.fieldType f) + ) + |> List.intersperse "\n , " + |> List.concat + ) + <> "\n }" + <> "\n\n\n" + <> serializer (PT.Model name meta fields) + <> "\n\n\n" + <> deserializer (PT.Model name meta fields) + +typesWriter :: [PT.DataTypes] -> String +typesWriter types = + List.map invTypeWriter types + |> List.intersperse "\n\n\n" + |> List.concat + +typesMap :: PT.Types -> String +typesMap = \case + PT.DTTStr -> "String" + PT.DTTInt -> "Int" + PT.DTTFloat -> "Float" + PT.DTTBool -> "Bool" + PT.DTTList a -> "[" <> typesMap a <> "]" + PT.DTTDict b -> "Map String " <> typesMap b + PT.DTTNullable a -> "Maybe " <> typesMap a + PT.DTTSet a -> "Set " <> typesMap a + PT.DTTPair a b -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ")" + PT.DTTTrio a b c -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ")" + PT.DTTQuad a b c d -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ")" + PT.DTTQuint a b c d e -> + "(" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ", " + <> typesMap e + <> ")" + PT.DefinedDataType t -> Text.unpack t |> Case.pascal + +valuesMap :: PT.Values -> String +valuesMap = \case + PT.VStr str -> "\"" <> str <> "\"" + PT.VInt int -> show int + PT.VFloat flt -> show flt + PT.VBool bl -> show bl + PT.VList lst -> + "[" + <> ( List.map valuesMap lst + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VDict map -> + "Map.fromList [" + <> ( List.map + ( \(k, v) -> + "(\"" + <> k + <> "\", " + <> valuesMap v + <> ")" + ) + (Map.toList map) + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VNullable nll -> case nll of + Just j -> "Just " <> valuesMap j + Nothing -> "Nothing" + PT.VSet set -> + "Set.fromList [" + <> ( List.map valuesMap (Set.toList set) + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VTuple2 (a, b) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ")" + PT.VTuple3 (a, b, c) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ")" + PT.VTuple4 (a, b, c, d) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ")" + PT.VTuple5 (a, b, c, d, e) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ", " + <> valuesMap e + <> ")" + PT.OtherValue t -> Text.unpack t |> Case.pascal + +serializerMap :: PT.Types -> String +serializerMap = \case + PT.DTTStr -> "(Aeson.toJSON)" + PT.DTTInt -> "(Aeson.toJSON)" + PT.DTTFloat -> "(Aeson.toJSON)" + PT.DTTBool -> "(Aeson.toJSON)" + PT.DTTList a -> + "(\\l -> AesonT.listValue (" + <> serializerMap a + <> ") l) " + PT.DTTDict v -> "(\\d -> Aeson.toJSON d) " + PT.DTTNullable a -> "(Aeson.toJSON)" + PT.DTTSet a -> + "(\\a -> Aeson.object " + <> "[ (fromString \"set\" :: Aeson.Key) Aeson..= " + <> serializerMap a + <> "a])" + PT.DTTPair a b -> + "(\\(a, b) -> Aeson.object " + <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " + <> serializerMap a + <> " a)" + <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " + <> serializerMap b + <> " b)" + <> "])" + PT.DTTTrio a b c -> + "(\\(a, b, c) -> Aeson.object " + <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " + <> serializerMap a + <> " a)" + <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " + <> serializerMap b + <> " b)" + <> ", ((fromString \"third\" :: Aeson.Key) Aeson..= " + <> serializerMap c + <> " c)" + <> "])" + PT.DTTQuad a b c d -> + "(\\(a, b, c, d) -> Aeson.object " + <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " + <> serializerMap a + <> " a)" + <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " + <> serializerMap b + <> " b)" + <> ", ((fromString \"third\" :: Aeson.Key) Aeson..= " + <> serializerMap c + <> " c)" + <> ", ((fromString \"fourth\" :: Aeson.Key) Aeson..= " + <> serializerMap d + <> " d)" + <> "])" + PT.DTTQuint a b c d e -> + "(\\(a, b, c, d, e) -> Aeson.object " + <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " + <> serializerMap a + <> " a)" + <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " + <> serializerMap b + <> " b)" + <> ", ((fromString \"third\" :: Aeson.Key) Aeson..= " + <> serializerMap c + <> " c)" + <> ", ((fromString \"fourth\" :: Aeson.Key) Aeson..= " + <> serializerMap d + <> " d)" + <> ", ((fromString \"fifth\" :: Aeson.Key) Aeson..= " + <> serializerMap e + <> " e)" + <> "])" + PT.DefinedDataType txt -> + "(" + <> (Text.unpack txt |> Case.camel) + <> "Encoder) " + +deserializerMap :: PT.Types -> String +deserializerMap = \case + PT.DTTStr -> "(Aeson.parseJSON)" + PT.DTTInt -> "(Aeson.parseJSON)" + PT.DTTFloat -> "(Aeson.parseJSON)" + PT.DTTBool -> "(Aeson.parseJSON)" + PT.DTTList a -> + "(AesonT.listParser (" + <> deserializerMap a + <> ")) " + PT.DTTDict v -> "(Aeson.parseJSON)" + PT.DTTNullable a -> "(Aeson.parseJSON)" + PT.DTTSet a -> + "(Aeson.withObject \"Set\" <| \\v ->" + <> "v Aeson..: (fromString \"set\" :: Aeson.Key) " + <> ">>= AesonT.listParser (" + <> deserializerMap a + <> ") " + <> ">>= return <. Set.fromList)" + PT.DTTPair a b -> + "(Aeson.withObject \"Tuple2\" <| \\v -> (,) " + <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" + <> deserializerMap a + <> ")) " + <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" + <> deserializerMap b + <> ")))" + PT.DTTTrio a b c -> + "(Aeson.withObject \"Tuple3\" <| \\v -> (,,) " + <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" + <> deserializerMap a + <> ")) " + <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" + <> deserializerMap b + <> ")) " + <> "<*> (v Aeson..: (fromString \"third\" :: Aeson.Key) >>= (" + <> deserializerMap c + <> ")))" + PT.DTTQuad a b c d -> + "(Aeson.withObject \"Tuple4\" <| \\v -> (,,,) " + <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" + <> deserializerMap a + <> ")) " + <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" + <> deserializerMap b + <> ")) " + <> "<*> (v Aeson..: (fromString \"third\" :: Aeson.Key) >>= (" + <> deserializerMap c + <> ")) " + <> "<*> (v Aeson..: (fromString \"fourth\" :: Aeson.Key) >>= (" + <> deserializerMap d + <> ")))" + PT.DTTQuint a b c d e -> + "(Aeson.withObject \"Tuple5\" <| \\v -> (,,,,) " + <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" + <> deserializerMap a + <> ")) " + <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" + <> deserializerMap b + <> ")) " + <> "<*> (v Aeson..: (fromString \"third\" :: Aeson.Key) >>= (" + <> deserializerMap c + <> ")) " + <> "<*> (v Aeson..: (fromString \"fourth\" :: Aeson.Key) >>= (" + <> deserializerMap d + <> ")) " + <> "<*> (v Aeson..: (fromString \"fifth\" :: Aeson.Key) >>= (" + <> deserializerMap e + <> ")))" + PT.DefinedDataType txt -> + "(" + <> (Text.unpack txt |> Case.camel) + <> "Decoder) " diff --git a/app/DataTypeTool/Lang/Haskell/Writer.hs b/app/DataTypeTool/Lang/Haskell/Writer.hs new file mode 100644 index 0000000..5faf245 --- /dev/null +++ b/app/DataTypeTool/Lang/Haskell/Writer.hs @@ -0,0 +1,22 @@ +module DataTypeTool.Lang.Haskell.Writer where + +import Data.Version + ( Version + , makeVersion + , showVersion + ) + +import qualified DataTypeTool.Common.Utils as Com +import DataTypeTool.Lang.Haskell.Config + ( LangConf (..) + ) +import qualified DataTypeTool.Lang.Haskell.Versions.GHCNineEightOne as GHC9_8_1 +import qualified DataTypeTool.Parsing.Types as PT + +haskellWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +haskellWriter langConf path typeData = + let haskV = langVersion langConf + in if + | langVersion langConf >= makeVersion [9, 8, 0] -> GHC9_8_1.writer langConf path typeData + | otherwise -> + print ("Unable to make out the correct writer for the specified Haskell version: " <> showVersion haskV) diff --git a/app/DataTypeTool/Lang/Python/Config.hs b/app/DataTypeTool/Lang/Python/Config.hs new file mode 100644 index 0000000..eace3bd --- /dev/null +++ b/app/DataTypeTool/Lang/Python/Config.hs @@ -0,0 +1,13 @@ +module DataTypeTool.Lang.Python.Config where + +import Data.Version ( Version ) + +import DataTypeTool.Parsing.Types ( DataTypes ) + +data LangConf + = LangConf + { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () + , outputLocation :: FilePath + , langVersion :: Version + } + deriving (Show) diff --git a/app/DataTypeTool/Lang/Python/Models.hs b/app/DataTypeTool/Lang/Python/Models.hs new file mode 100644 index 0000000..06d7977 --- /dev/null +++ b/app/DataTypeTool/Lang/Python/Models.hs @@ -0,0 +1,38 @@ +module DataTypeTool.Lang.Python.Models where + + +{- + Python "Alias" + + <3.12 + SomeAlias = typing.TypeAlias[typing.Tuple[str, bool]] + >=3.12: + type SomeAlias = typing.Tuple[str, bool] +-} + + +{- + Python "Enums" + + class SomeEnum(enum.Enum): + MEM_A = "mem_a" + MEM_B = "mem_b" + MEM_C = "mem_c" +-} + + +{- + Python "Models" + + @dataclasses.dataclass + class SomeModel: + field_a: str + field_b: int +-} + + +{- + Python "Constants" + + SOME_CONSTANT: typing.Final[str] = "A Value" +-} diff --git a/app/DataTypeTool/Lang/Python/Toml.hs b/app/DataTypeTool/Lang/Python/Toml.hs new file mode 100644 index 0000000..2622cc9 --- /dev/null +++ b/app/DataTypeTool/Lang/Python/Toml.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE + OverloadedStrings + #-} + +module DataTypeTool.Lang.Python.Toml where + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Python.Config + ( LangConf (..) + ) +import qualified DataTypeTool.Lang.Python.Versions.CPythonThreeTenTwelve as CPy3_10_12 +import DataTypeTool.Lang.Python.Writer + ( pythonWriter + ) + +import Toml + ( (.=) + ) +import qualified Toml + +confCodec :: Toml.TomlCodec LangConf +confCodec = + LangConf + <$> pure pythonWriter + <*> Toml.string "output_location" .= outputLocation + <*> Extras.versionCodec "lang_version" .= langVersion diff --git a/app/DataTypeTool/Lang/Python/Versions/CPythonThreeTenTwelve.hs b/app/DataTypeTool/Lang/Python/Versions/CPythonThreeTenTwelve.hs new file mode 100644 index 0000000..4f99795 --- /dev/null +++ b/app/DataTypeTool/Lang/Python/Versions/CPythonThreeTenTwelve.hs @@ -0,0 +1,603 @@ +module DataTypeTool.Lang.Python.Versions.CPythonThreeTenTwelve where + +import qualified Antelude.File as File +import qualified Antelude.List as List +import qualified Antelude.Maybe as Maybe + +import qualified Control.Monad as Monad + +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Extras as Extras +import DataTypeTool.Lang.Python.Config ( LangConf (..) ) +import qualified DataTypeTool.Parsing.Types as PT + +import qualified System.Directory as Dir +import System.IO ( FilePath ) + +import qualified Text.Casing as Case + +writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +writer pythonConf baseDir = + let path :: FilePath -> FilePath + path pth = (baseDir <> outputLocation pythonConf <> pythonDirPath pth) + in Monad.mapM_ + ( \(pth, lstType) -> + Dir.createDirectoryIfMissing + True + ( baseDir + <> outputLocation pythonConf + <> "/dtt/" + <> pythonDirPath pth + ) + >> File.writeFile + ( baseDir + <> outputLocation pythonConf + <> "/dtt/" + <> pythonFilePath pth + ) + ( header + <> staticImports + <> mapReferencedImports (pth, lstType) + <> "\n\n" + <> ( List.map + invTypeWriter + lstType + |> List.intersperse "\n\n\n" + |> List.concat + ) + ) + ) + +pythonDirPath :: FilePath -> FilePath +pythonDirPath = + Com.typeFilePathToLangDirPath + Com.QuietSnakeCase + +pythonFilePath :: FilePath -> FilePath +pythonFilePath = + Com.typeFilePathToLangFilePath + Com.QuietSnakeCase + ".py" + +-- for the header of files, imports, etc +pythonCodePath :: FilePath -> String +pythonCodePath = + Com.typeFilePathToLangCodePath + Com.QuietSnakeCase + '.' + +header :: String +header = + "# This file was generated by DataTypeTool\n\n" + +staticImports :: String +staticImports = + "from json import (JSONDecodeError, loads, dumps)\n" + <> "from enum import Enum\n" + <> "from dataclasses import dataclass\n" + <> "import typing\n" + +mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String +mapReferencedImports (_, lstDtaTypes) = + let referencedImports :: [(FilePath, [PT.Types])] -> String + referencedImports metaStuff = + ( List.map + ( \(fp, lstTypes) -> + "from " + <> pythonCodePath fp + <> " import (" + <> ( lstTypes + |> List.map + ( \case + PT.DefinedDataType txt -> + (typesMap <| PT.DefinedDataType txt) + <> ", " + <> (Text.unpack txt |> Case.quietSnake) + <> "_encoder, " + <> (deserializerMap <| PT.DefinedDataType txt) + _ -> "" + ) + |> List.filter (/= "") + |> List.intersperse ", " + |> List.concat + ) + <> ")" + ) + metaStuff + |> List.intersperse "\n" + |> List.concat + ) + <> "\n" + in List.map + ( \dtaType -> + case dtaType of + PT.Alias _ meta _ -> meta + PT.Enum _ meta _ -> meta + PT.Model _ meta _ -> meta + PT.Constant _ meta _ _ -> meta + |> \case + Just m -> + Maybe.map referencedImports (PT.metaRef m) + |> Maybe.withDefault "" + Nothing -> "" + ) + lstDtaTypes + |> List.filter (/= "") + |> List.intersperse "\n" + |> List.concat + +docCommentsString :: Maybe PT.MetaField -> String +docCommentsString = \case + Just meta -> + case PT.metaDoc meta of + Just doc -> + "\n \"\"\"\n " + <> ( List.lines (Text.unpack doc) + |> List.filter (/= "") + |> List.intersperse "\n " + |> List.concat + ) + <> "\n \"\"\"" + Nothing -> "" + Nothing -> "" + +docCommentsHash :: Maybe PT.MetaField -> String +docCommentsHash = \case + Just meta -> + case PT.metaDoc meta of + Just doc -> + "# " + <> ( List.lines (Text.unpack doc) + |> List.filter (/= "") + |> List.intersperse "\n# " + |> List.concat + ) + <> "\n" + Nothing -> "" + Nothing -> "" + +-- serializer :: PT.DataTypes -> String +-- serializer (PT.Constant name meta type_ value) = "" +-- serializer (PT.Alias name meta type_) = +-- "def " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_encoder(obj: " +-- <> (Text.unpack name |> Case.pascal) +-- <> ") -> str:" +-- <> "\n return dumps(" +-- <> serializerMap type_ +-- <> "(obj))" +-- serializer (PT.Enum name meta members) = +-- "def " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_encoder(obj: " +-- <> (Text.unpack name |> Case.pascal) +-- <> ") -> str:" +-- <> "\n match obj:" +-- <> "\n " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( "case " +-- <> (Text.unpack name |> Case.pascal) +-- <> "." +-- <> (Text.unpack txt |> Case.pascal) +-- <> ":\n return dumps(\"" +-- <> (Text.unpack txt |> Case.quietSnake) +-- <> "\")" +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- serializer (PT.Model name meta fields) = +-- "def " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_encoder(obj: " +-- <> (Text.unpack name |> Case.pascal) +-- <> ") -> str:" +-- <> "\n return dumps({" +-- <> "\n " +-- <> ( List.map +-- (\field -> +-- "\"" +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "\": " +-- <> (PT.fieldType field |> serializerMap) +-- <> "(obj." +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> ")" +-- ) +-- fields +-- |> List.intersperse ",\n " +-- |> List.concat +-- ) +-- <> "\n })" + +-- deserializer :: PT.DataTypes -> String +-- deserializer (PT.Constant name meta type_ value) = "" +-- deserializer (PT.Alias name meta type_) = +-- "def " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_decoder(json_val: str | bytes | bytearray) -> " +-- <> (Text.unpack name |> Case.pascal) +-- <> " | typing.NoReturn:" +-- <> "\n return " +-- <> deserializerMap type_ +-- <> "(json_val) or None" +-- deserializer (PT.Enum name meta members) = +-- "def " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_decoder(json_val: typing.Union[str, bytes, bytearray]) -> " +-- <> (Text.unpack name |> Case.pascal) +-- <> " | typing.NoReturn:" +-- <> "\n match loads(json_val):" +-- <> "\n " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( "case \"" +-- <> (Text.unpack txt |> Case.quietSnake) +-- <> "\":\n return " +-- <> (Text.unpack name |> Case.pascal) +-- <> "." +-- <> (Text.unpack txt |> Case.pascal) +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse "\n " +-- |> List.concat +-- ) +-- <> "\n case err:" +-- <> "\n raise JSONDecodeError(" +-- <> "\n f\"Expected one of: " +-- <> ( List.map +-- (\case +-- PT.OtherValue txt -> +-- ( "\\\"" +-- <> (Text.unpack txt |> Case.quietSnake) +-- <> "\\\"" +-- ) +-- _ -> "" +-- ) +-- members +-- |> List.filter (/= "") +-- |> List.intersperse ", " +-- |> List.concat +-- ) +-- <> ", Found: {err}\", json_val, None" +-- <> "\n )" +-- deserializer (PT.Model name meta fields) = +-- "def " +-- <> (Text.unpack name |> Case.quietSnake) +-- <> "_decoder(json_val: typing.Union[str, bytes, bytearray, dict]) -> " +-- <> (Text.unpack name |> Case.pascal) +-- <> " | typing.NoReturn:" +-- <> "\n json_dict = loads(json_val) if not isinstance(json_val, dict) else json_val\n " +-- <> "return " +-- <> (Text.unpack name |> Case.pascal) +-- <> "(" +-- <> ( List.map +-- (\field -> +-- "\n " +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> " = " +-- <> (PT.fieldType field |> deserializerMap) +-- <> "(json_dict.get(\"" +-- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) +-- <> "\"))" +-- ) +-- fields +-- |> List.intersperse "," +-- |> List.concat +-- ) +-- <> "\n )" + +invTypeWriter :: PT.DataTypes -> String +invTypeWriter (PT.Constant name meta type_ value) = + docCommentsHash meta + <> (Text.unpack name |> Case.screamingSnake) + <> ": typing.Final[" + <> typesMap type_ + <> "] = " + <> valuesMap value +invTypeWriter (PT.Alias name meta type_) = + docCommentsHash meta + <> (Text.unpack name |> Case.pascal) + <> ": typing.TypeAlias = " + <> typesMap type_ + <> "\n\n\n" + -- <> serializer (PT.Alias name meta type_) + <> "\n\n\n" +-- <> deserializer (PT.Alias name meta type_) +invTypeWriter (PT.Enum name meta members) = + "class " + <> (Text.unpack name |> Case.pascal) + <> "(Enum):" + <> docCommentsString meta + <> "\n " + <> ( members + |> List.map + ( \m -> + (valuesMap m |> Case.pascal) + <> " = \"" + <> (valuesMap m |> Case.quietSnake) + <> "\"" + ) + |> List.intersperse "\n " + |> List.concat + ) + <> "\n\n\n" + -- <> serializer (PT.Enum name meta members) + <> "\n\n\n" +-- <> deserializer (PT.Enum name meta members) +invTypeWriter (PT.Model name meta fields) = + "@dataclass\nclass " + <> (Text.unpack name |> Case.pascal) + <> ":" + <> docCommentsString meta + <> "\n " + <> ( fields + |> List.map + ( \f -> + (Text.unpack (PT.fieldName f) |> Case.quietSnake) + <> ": " + <> typesMap (PT.fieldType f) + ) + |> List.intersperse "\n " + |> List.concat + ) + <> "\n\n\n" + -- <> serializer (PT.Model name meta fields) + <> "\n\n\n" + +-- <> deserializer (PT.Model name meta fields) + +typesWriter :: [PT.DataTypes] -> String +typesWriter types = + List.map invTypeWriter types + |> List.intersperse "\n\n\n" + |> List.concat + +typesMap :: PT.Types -> String +typesMap = \case + PT.DTTStr -> "str" + PT.DTTInt -> "int" + PT.DTTFloat -> "float" + PT.DTTBool -> "bool" + PT.DTTList a -> "list[" <> typesMap a <> "]" + PT.DTTDict b -> "dict[str, " <> typesMap b <> "]" + PT.DTTNullable a -> typesMap a <> " | None" + PT.DTTSet a -> "set[" <> typesMap a <> "]" + PT.DTTPair a b -> + "tuple[" + <> typesMap a + <> ", " + <> typesMap b + <> "]" + PT.DTTTrio a b c -> + "tuple[" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> "]" + PT.DTTQuad a b c d -> + "tuple[" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> "]" + PT.DTTQuint a b c d e -> + "tuple[" + <> typesMap a + <> ", " + <> typesMap b + <> ", " + <> typesMap c + <> ", " + <> typesMap d + <> ", " + <> typesMap e + <> "]" + PT.DefinedDataType t -> Text.unpack t |> Case.pascal + +valuesMap :: PT.Values -> String +valuesMap = \case + PT.VStr str -> "\"" <> str <> "\"" + PT.VInt int -> show int + PT.VFloat flt -> show flt + PT.VBool bl -> show bl + PT.VList lst -> + "[" + <> ( List.map valuesMap lst + |> List.intersperse ", " + |> List.concat + ) + <> "]" + PT.VDict map -> + "{" + <> ( List.map + ( \(k, v) -> + "#(" + <> k + <> ", " + <> valuesMap v + <> ")" + ) + (Map.toList map) + |> List.intersperse ", " + |> List.concat + ) + <> "}" + PT.VNullable nll -> (Maybe.mapWithDefault "None" valuesMap nll) + PT.VSet set -> + "{" + <> ( List.map valuesMap (Set.toList set) + |> List.intersperse ", " + |> List.concat + ) + <> "}" + PT.VTuple2 (a, b) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ")" + PT.VTuple3 (a, b, c) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ")" + PT.VTuple4 (a, b, c, d) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ")" + PT.VTuple5 (a, b, c, d, e) -> + "(" + <> valuesMap a + <> ", " + <> valuesMap b + <> ", " + <> valuesMap c + <> ", " + <> valuesMap d + <> ", " + <> valuesMap e + <> ")" + PT.OtherValue t -> Text.unpack t |> Case.pascal + +serializerMap :: PT.Types -> String +serializerMap = \case + PT.DTTStr -> "str" + PT.DTTInt -> "int" + PT.DTTFloat -> "float" + PT.DTTBool -> "bool" + PT.DTTList a -> "(lambda l: [" <> serializerMap a <> "(lj) for lj in l])" + PT.DTTDict v -> + "(lambda d: { k: " + <> serializerMap v + <> "(v) for k, v in d})" + PT.DTTNullable a -> "(lambda n: " <> serializerMap a <> "(n) if n is not None else None)" + PT.DTTSet a -> + "(lambda s: { \"set\": [" + <> serializerMap a + <> "(a) for a in s]})" + PT.DTTPair a b -> + "(lambda t: { \"first\": " + <> serializerMap a + <> "(t[0]), \"second\": " + <> serializerMap b + <> "(t[1])})" + PT.DTTTrio a b c -> + "(lambda t: { \"first\": " + <> serializerMap a + <> "(t[0]), \"second\": " + <> serializerMap b + <> "(t[1]), \"third\": " + <> serializerMap b + <> "(t[2])})" + PT.DTTQuad a b c d -> + "(lambda t: { \"first\": " + <> serializerMap a + <> "(t[0]), \"second\": " + <> serializerMap b + <> "(t[1]), \"third\": " + <> serializerMap b + <> "(t[2]), \"fourth\": " + <> serializerMap b + <> "(t[3])})" + PT.DTTQuint a b c d e -> + "(lambda t: { \"first\": " + <> serializerMap a + <> "(t[0]), \"second\": " + <> serializerMap b + <> "(t[1]), \"third\": " + <> serializerMap b + <> "(t[2]), \"fourth\": " + <> serializerMap b + <> "(t[3]), \"fifth\": " + <> serializerMap b + <> "(t[4])})" + PT.DefinedDataType txt -> "(lambda dt: loads(" <> (Text.unpack txt |> Case.quietSnake) <> "_encoder(dt)))" + +deserializerMap :: PT.Types -> String +deserializerMap = \case + PT.DTTStr -> "str" + PT.DTTInt -> "int" + PT.DTTFloat -> "float" + PT.DTTBool -> "bool" + PT.DTTList a -> "(lambda list_json: [" <> deserializerMap a <> "(l) for l in list_json])" + PT.DTTDict v -> + "(lambda dict_json: {k: " + <> deserializerMap v + <> "(v) for k, v in dict_json})" + PT.DTTNullable a -> "(lambda n: " <> serializerMap a <> "(n) if n is not None else None)" + PT.DTTSet a -> + "(lambda set_json: set([" + <> deserializerMap a + <> "(s) for s in set_json.get(\"set\")]))" + PT.DTTPair a b -> + "(lambda tup_json: (" + <> deserializerMap a + <> "(tup_json.get(\"first\")), " + <> deserializerMap b + <> "(tup_json.get(\"second\"))" + <> "))" + PT.DTTTrio a b c -> + "(lambda tup_json: (" + <> deserializerMap a + <> "(tup_json.get(\"first\")), " + <> deserializerMap b + <> "(tup_json.get(\"second\")), " + <> deserializerMap c + <> "(tup_json.get(\"third\"))" + <> "))" + PT.DTTQuad a b c d -> + "(lambda tup_json: (" + <> deserializerMap a + <> "(tup_json.get(\"first\")), " + <> deserializerMap b + <> "(tup_json.get(\"second\")), " + <> deserializerMap c + <> "(tup_json.get(\"third\")), " + <> deserializerMap d + <> "(tup_json.get(\"fourth\"))" + <> "))" + PT.DTTQuint a b c d e -> + "(lambda tup_json: (" + <> deserializerMap a + <> "(tup_json.get(\"first\")), " + <> deserializerMap b + <> "(tup_json.get(\"second\")), " + <> deserializerMap c + <> "(tup_json.get(\"third\")), " + <> deserializerMap d + <> "(tup_json.get(\"fourth\")), " + <> deserializerMap e + <> "(tup_json.get(\"fifth\"))" + <> "))" + PT.DefinedDataType txt -> Text.unpack txt |> Case.quietSnake |> (<> "_decoder") diff --git a/app/DataTypeTool/Lang/Python/Writer.hs b/app/DataTypeTool/Lang/Python/Writer.hs new file mode 100644 index 0000000..37c0a6e --- /dev/null +++ b/app/DataTypeTool/Lang/Python/Writer.hs @@ -0,0 +1,27 @@ +module DataTypeTool.Lang.Python.Writer where + +import Data.Version + ( Version + , makeVersion + , showVersion + ) + +import qualified DataTypeTool.Common.Utils as Com +import DataTypeTool.Lang.Python.Config + ( LangConf (..) + ) +import qualified DataTypeTool.Lang.Python.Versions.CPythonThreeTenTwelve as CPy3_10_12 +import qualified DataTypeTool.Parsing.Types as PT + +pythonWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () +pythonWriter langConf path typeData = + let pyV = langVersion langConf + in if + | ( Com.betweenOrEqualLower + pyV + (makeVersion [3, 10, 0]) + (makeVersion [3, 11, 0]) + ) -> + CPy3_10_12.writer langConf path typeData + | otherwise -> + print ("Unable to make out the correct writer for the specified Python version: " <> showVersion pyV) diff --git a/app/DataTypeTool/Parsing/Parser.hs b/app/DataTypeTool/Parsing/Parser.hs new file mode 100644 index 0000000..ecc18c9 --- /dev/null +++ b/app/DataTypeTool/Parsing/Parser.hs @@ -0,0 +1,828 @@ +module DataTypeTool.Parsing.Parser where + +import qualified Antelude.List as List +import qualified Antelude.List.NonEmpty as NE +import qualified Antelude.Maybe as Maybe +import Antelude.Monad + ( fail + , mapM + , mapM_ + , replicateM_ + , void + ) +import qualified Antelude.Monad as Monad +import Antelude.String ( fromString ) + +import qualified Data.List as UnsafeList ( head ) +import Data.Map.Strict ( (!) ) +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +import qualified DataTypeTool.Common.Utils as Com +import DataTypeTool.Config.Config + ( LangConfiguration (EmptyConfig) + , targets + ) +import qualified DataTypeTool.Config.Config as Config +import qualified DataTypeTool.Parsing.Types as PT + +import qualified System.Directory as Dir +import qualified System.Exit as Exit ( die ) + +import qualified Text.Megaparsec as MP +import qualified Text.Megaparsec.Char as MPC +import qualified Text.Megaparsec.Char.Lexer as MPCL +import qualified Text.Megaparsec.Debug as MPD + +type Parser = MP.Parsec Void String + +type Spacer = Parser () + +runParsers + :: FilePath + -> Config.Config + -> IO + ( List + ( FilePath + , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile + ) + ) +runParsers typeFileDirectory config = + let runReal + :: List (FilePath, String) + -> IO + ( List + ( FilePath + , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile + ) + ) + runReal = + List.map + ( \(pth, str) -> + ( List.stripPrefix typeFileDirectory pth + |> Maybe.withDefault pth + , ( case List.last str of + Just '\n' -> str + _ -> str <> "\n" + ) + |> MP.parse (parser (Config.spacing config)) pth + ) + ) + .> return + + runTest + :: List (FilePath, String) + -> IO + ( List + ( FilePath + , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile + ) + ) + runTest lst = + Monad.mapM_ + ( \(pth, str) -> + MP.parseTest (parser (Config.spacing config)) str + ) + lst + >> return [] + in case NE.head config.targets of + EmptyConfig -> + Exit.die "No targets defined. Please set up languages to generate types for." + _ -> + Com.recurseDirectory typeFileDirectory + -- >>= runTest + >>= runReal + + +parser :: Config.Spacing -> Parser PT.DataTypeFile +parser spacing = + let spacer :: Parser () + spacer = case spacing of + Config.Tabs -> tab + Config.Spaces2 -> space2 + Config.Spaces3 -> space3 + Config.Spaces4 -> space4 + + spacePos :: Int + spacePos = case spacing of + Config.Tabs -> 4 + Config.Spaces2 -> 2 + Config.Spaces3 -> 3 + Config.Spaces4 -> 4 + + dataTypeParser :: Parser PT.DataTypes + dataTypeParser = + MPCL.nonIndented + spaceAny + ( MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "alias " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (aliasMapper name <. Map.toList <. Map.fromList) + aliasParser + ) + , MPCL.indentBlock spaceAny <| do + voidString "enum " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (enumMapper name <. Map.toList <. Map.fromList) + enumParser + ) + , MPCL.indentBlock spaceAny <| do + voidString "model " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (modelMapper name <. Map.toList <. Map.fromList) + modelParser + ) + , MPCL.indentBlock spaceAny <| do + voidString "constant " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (constantMapper name <. Map.toList <. Map.fromList) + constantParser + ) + ] + ) + + aliasMapper :: Text -> [(String, PT.AliasParams)] -> Parser PT.DataTypes + aliasMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.AliasMeta m) -> m + _ -> Nothing + ) + + type_ :: Maybe PT.Types + type_ = + ( List.lookup "type" map + |> \case + Just (PT.AliasType t) -> Just t + _ -> Nothing + ) + in case type_ of + Just t -> return <| PT.Alias name meta t + _ -> fail "Insufficient parameters passed to alias type" + + aliasParser :: Parser (String, PT.AliasParams) + aliasParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.AliasMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "type:" + indentWrapper + "type" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.AliasType <. UnsafeList.head) + typeParser + ] + + enumMapper :: Text -> [(String, PT.EnumParams)] -> Parser PT.DataTypes + enumMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.EnumMeta m) -> m + _ -> Nothing + ) + + members :: Maybe [PT.Values] + members = + ( List.lookup "members" map + |> \case + Just (PT.EnumMembers e) -> Just e + _ -> Nothing + ) + in case members of + Just m -> return <| PT.Enum name meta m + _ -> fail "Insufficient parameters passed to enum type" + + enumParser :: Parser (String, PT.EnumParams) + enumParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.EnumMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "members:" + indentWrapper + "members" + (MP.mkPos <| 1 + (spacePos * 2)) + PT.EnumMembers + valueParser + ] + + modelMapper :: Text -> [(String, PT.ModelParams)] -> Parser PT.DataTypes + modelMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.ModelMeta m) -> m + _ -> Nothing + ) + + fields :: Maybe [PT.ModelField] + fields = + ( List.lookup "fields" map + |> \case + Just (PT.ModelFields f) -> Just f + _ -> Nothing + ) + in case fields of + Just f -> return <| PT.Model name meta f + _ -> fail "Insufficient parameters passed to model type" + + modelParser :: Parser (String, PT.ModelParams) + modelParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ModelMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "fields:" + indentWrapper + "fields" + (MP.mkPos <| 1 + (spacePos * 2)) + PT.ModelFields + modelFieldsParser + ] + + modelFieldsParser :: Parser PT.ModelField + modelFieldsParser = + MPCL.lexeme spacer <| + MPCL.indentBlock spaceAny <| + do + voidString "field " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just <| (MP.mkPos <| 1 + (spacePos * 3))) + (return <. fieldMapper name) + fieldParser + ) + + fieldMapper :: Text -> [PT.Types] -> PT.ModelField + fieldMapper name types = + PT.ModelField name (UnsafeList.head types) + + fieldParser :: Parser PT.Types + fieldParser = + MPCL.lexeme spacer <| + MPCL.indentBlock spaceAny <| + do + voidString "type:" + return + ( MPCL.IndentMany + (Just <| (MP.mkPos <| 1 + (spacePos * 4))) + (return <. UnsafeList.head) + typeParser + ) + + constantMapper :: Text -> [(String, PT.ConstantParams)] -> Parser PT.DataTypes + constantMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.ConstantMeta m) -> m + _ -> Nothing + ) + + type_ :: Maybe PT.Types + type_ = + ( List.lookup "type" map + |> \case + Just (PT.ConstantType t) -> Just t + _ -> Nothing + ) + + value :: Maybe PT.Values + value = + ( List.lookup "value" map + |> \case + Just (PT.ConstantValue v) -> Just v + _ -> Nothing + ) + in case (type_, value) of + (Just t, Just v) -> return <| PT.Constant name meta t v + _ -> fail "Insufficient parameters passed to constant type" + + constantParser :: Parser (String, PT.ConstantParams) + constantParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ConstantMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "type:" + indentWrapper + "type" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ConstantType <. UnsafeList.head) + typeParser + , MPCL.indentBlock spaceAny <| do + voidString "value:" + indentWrapper + "value" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ConstantValue <. UnsafeList.head) + valueParser + ] + + metaMapper :: [(String, PT.MetaParams)] -> Maybe PT.MetaField + metaMapper map = + let doc :: Maybe Text + doc = + ( List.lookup "doc" map + |> \case + Just (PT.MetaDoc d) -> d + _ -> Nothing + ) + + ref :: Maybe [(FilePath, [PT.Types])] + ref = + ( List.lookup "ref" map + |> \case + Just (PT.MetaRef r) -> r + _ -> Nothing + ) + + lang :: Maybe [Text] + lang = + ( List.lookup "lang" map + |> \case + Just (PT.MetaLang l) -> l + _ -> Nothing + ) + in case (doc, ref, lang) of + (Nothing, Nothing, Nothing) -> fail "No parameters passed to meta field, but a meta field was opened." + _ -> return <| PT.MetaField doc ref lang + + metaParser :: Parser (String, PT.MetaParams) + metaParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "doc:" + indentWrapper + "doc" + (MP.mkPos <| 1 + (spacePos * 3)) + (PT.MetaDoc <. docMapper) + docParser + , MPCL.indentBlock spaceAny <| do + voidString "ref:" + indentWrapper + "ref" + (MP.mkPos <| 1 + (spacePos * 3)) + (PT.MetaRef <. Just) + refParser + , MPCL.indentBlock spaceAny <| do + voidString "lang:" + indentWrapper + "lang" + (MP.mkPos <| 1 + (spacePos * 3)) + (PT.MetaLang <. Just) + langParser + ] + + docMapper :: [Text] -> Maybe Text + docMapper docLines = Just <| List.foldl (\a b -> a <> Text.pack "\n" <> b) (Text.pack "") docLines + + docParser :: Parser Text + docParser = + MPCL.lexeme spacer <| + MP.manyTill MPCL.charLiteral eol + >>= return <. Text.pack + + refParser :: Parser (FilePath, [PT.Types]) + refParser = + MPCL.lexeme spacer <| + do + path <- pathParser + colon + types_ <- MP.sepBy1 definedTypeParser colon + return <| + ( path + , types_ + ) + + langParser :: Parser Text + langParser = langLangParser + + langLangParser :: Parser Text + langLangParser = + MPCL.lexeme spacer <| do + lang <- + MP.choice + [ MPC.string "haskell" + , MPC.string "python" + , MPC.string "elm" + , MPC.string "gleam" + ] + >>= return <. Text.pack + eol + return lang + + typeParser :: Parser PT.Types + typeParser = + let type_ :: Parser PT.Types + type_ = + MP.choice + [ PT.DTTStr <$ MPC.string "Str" + , PT.DTTInt <$ MPC.string "Int" + , PT.DTTFloat <$ MPC.string "Float" + , PT.DTTBool <$ MPC.string "Bool" + , do + voidString "Dict " + PT.DTTDict <$> typeParser + , do + voidString "List " + PT.DTTList <$> typeParser + , do + voidString "Nullable " + PT.DTTNullable <$> typeParser + , do + voidString "Set " + PT.DTTSet <$> typeParser + , do + voidString "Tuple2" + PT.DTTPair + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , do + voidString "Tuple3" + PT.DTTTrio + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , do + voidString "Tuple4" + PT.DTTQuad + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , do + voidString "Tuple5" + PT.DTTQuint + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , definedTypeParser + ] + in ( do + MPC.char '(' + spaceAny + t <- type_ + spaceAny + MPC.char ')' + return t + ) + <|> type_ + + valueParser :: Parser PT.Values + valueParser = + let val = + MP.choice + [ MPC.char '"' + >> MP.manyTill MPCL.charLiteral (MPC.char '"') + >>= return <. PT.VStr + , ( MPCL.signed spaceAny <| + MPCL.lexeme spacer <| + MPCL.decimal + ) + >>= return <. PT.VInt + , ( MPCL.signed spaceAny <| + MPCL.lexeme spacer <| + MPCL.float + ) + >>= return <. PT.VFloat + , MP.choice + [ PT.VBool True <$ MPC.string "True" + , PT.VBool False <$ MPC.string "False" + ] + , MPCL.lexeme spaceAny <| + voidString "Dict" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "[") + (MPCL.symbol spaceAny "]") + ( MP.sepBy + ( MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + k <- + MPC.char '"' + >> MP.manyTill MPCL.charLiteral (MPC.char '"') + voidString ", " + v <- valueParser + return (k, v) + ) + ) + (voidString ", ") + ) + >>= return <. PT.VDict <. Map.fromList + , MPCL.lexeme spaceAny <| + voidString "List" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "[") + (MPCL.symbol spaceAny "]") + (MP.sepBy valueParser (MPC.char ',')) + >>= return <. PT.VList + , MP.choice + [ do + voidString "NotNull " + jVal <- valueParser + return <| PT.VNullable <| Just jVal + , PT.VNullable Nothing <$ voidString "Null" + ] + , MPCL.lexeme spaceAny <| + voidString "Set" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "[") + (MPCL.symbol spaceAny "]") + ( MP.sepBy valueParser (MPC.char ',') + >>= return <. PT.VSet <. Set.fromList + ) + , MPCL.lexeme spaceAny <| + voidString "Tuple2" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + return (a, b) + ) + >>= return <. PT.VTuple2 + , MPCL.lexeme spaceAny <| + voidString "Tuple3" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + c <- valueParser + return (a, b, c) + ) + >>= return <. PT.VTuple3 + , MPCL.lexeme spaceAny <| + voidString "Tuple4" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + c <- valueParser + d <- valueParser + return (a, b, c, d) + ) + >>= return <. PT.VTuple4 + , MPCL.lexeme spaceAny <| + voidString "Tuple5" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + c <- valueParser + d <- valueParser + e <- valueParser + return (a, b, c, d, e) + ) + >>= return <. PT.VTuple5 + , MPCL.lexeme spaceAny <| + nameParser + >>= return <. PT.OtherValue + ] + in MP.between + (MPCL.symbol spaceAny "(") + (MPCL.symbol spaceAny ")") + val + <|> val + + nameParser :: Parser Text + nameParser = + MPCL.lexeme spacer <| do + first <- MPC.upperChar + rest <- + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + ] + ) + return <| Text.pack (first : rest) + + -- A specific packed version of nameParser + definedTypeParser :: Parser PT.Types -- Specifically (DefinedDataType Text) + definedTypeParser = + MPCL.lexeme spacer <| do + first <- MPC.upperChar + rest <- + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + ] + ) + return <| PT.DefinedDataType <| Text.pack (first : rest) + + pathParser :: Parser FilePath + pathParser = + MPCL.lexeme spacer <| + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + , MPC.char '-' + , MPC.char '/' + , MPC.char '\\' + ] + ) + + pathAsTextParser :: Parser Text + pathAsTextParser = + MPCL.lexeme spacer <| + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + , MPC.char '-' + , MPC.char '/' + , MPC.char '\\' + ] + ) + >>= return <. Text.pack + + anyNameParser :: Parser Text + anyNameParser = + MPCL.lexeme spacer <| do + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + ] + ) + >>= return <. Text.pack + + indentWrapper + :: String + -> MP.Pos + -> ([a] -> c) + -> Parser a + -> Parser + ( MPCL.IndentOpt + Parser + (String, c) + a + ) + indentWrapper field pos wrapperMapper parser = + return + ( MPCL.IndentMany + (Just pos) + ( \a -> + return (field, wrapperMapper a) + ) + parser + ) + in MP.someTill + dataTypeParser + MP.eof + +lineComment :: Parser () +lineComment = + MPCL.skipLineComment "#" + +space2 :: Parser () +space2 = + MPCL.space + (replicateM_ 2 (MPC.char ' ')) + lineComment + MP.empty + +space3 :: Parser () +space3 = + MPCL.space + (replicateM_ 3 (MPC.char ' ')) + lineComment + MP.empty + +space4 :: Parser () +space4 = + MPCL.space + (replicateM_ 4 (MPC.char ' ')) + lineComment + MP.empty + +tab :: Parser () +tab = + MPCL.space + (void <| MPC.char '\t') + lineComment + MP.empty + +spaceAny :: Parser () +spaceAny = + MPCL.space + MPC.space1 + lineComment + MP.empty + +eol :: Parser () +eol = void MPC.eol + +colon :: Parser () +colon = void (MPC.char ':') + +voidString :: String -> Parser () +voidString str = void (MPC.string str) + +nullParser :: Parser () +nullParser = return () diff --git a/app/DataTypeTool/Parsing/ParserOld.hs b/app/DataTypeTool/Parsing/ParserOld.hs new file mode 100644 index 0000000..d2bd40e --- /dev/null +++ b/app/DataTypeTool/Parsing/ParserOld.hs @@ -0,0 +1,828 @@ +module DataTypeTool.Parsing.ParserOld where + +import qualified Antelude.List as List +import qualified Antelude.List.NonEmpty as NE +import qualified Antelude.Maybe as Maybe +import Antelude.Monad + ( fail + , mapM + , mapM_ + , replicateM_ + , void + ) +import qualified Antelude.Monad as Monad +import Antelude.String ( fromString ) + +import qualified Data.List as UnsafeList ( head ) +import Data.Map.Strict ( (!) ) +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +import qualified DataTypeTool.Common.Utils as Com +import DataTypeTool.Config.Config + ( LangConfiguration (EmptyConfig) + , targets + ) +import qualified DataTypeTool.Config.Config as Config +import qualified DataTypeTool.Parsing.Types as PT + +import qualified System.Directory as Dir +import qualified System.Exit as Exit ( die ) + +import qualified Text.Megaparsec as MP +import qualified Text.Megaparsec.Char as MPC +import qualified Text.Megaparsec.Char.Lexer as MPCL +import qualified Text.Megaparsec.Debug as MPD + +type Parser = MP.Parsec Void String + +type Spacer = Parser () + +runParsers + :: FilePath + -> Config.Config + -> IO + ( List + ( FilePath + , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile + ) + ) +runParsers typeFileDirectory config = + let runReal + :: List (FilePath, String) + -> IO + ( List + ( FilePath + , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile + ) + ) + runReal = + List.map + ( \(pth, str) -> + ( List.stripPrefix typeFileDirectory pth + |> Maybe.withDefault pth + , ( case List.last str of + Just '\n' -> str + _ -> str <> "\n" + ) + |> MP.parse (parser (Config.spacing config)) pth + ) + ) + .> return + + runTest + :: List (FilePath, String) + -> IO + ( List + ( FilePath + , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile + ) + ) + runTest lst = + Monad.mapM_ + ( \(pth, str) -> + MP.parseTest (parser (Config.spacing config)) str + ) + lst + >> return [] + in case NE.head config.targets of + EmptyConfig -> + Exit.die "No targets defined. Please set up languages to generate types for." + _ -> + Com.recurseDirectory typeFileDirectory + -- >>= runTest + >>= runReal + + +parser :: Config.Spacing -> Parser PT.DataTypeFile +parser spacing = + let spacer :: Parser () + spacer = case spacing of + Config.Tabs -> tab + Config.Spaces2 -> space2 + Config.Spaces3 -> space3 + Config.Spaces4 -> space4 + + spacePos :: Int + spacePos = case spacing of + Config.Tabs -> 4 + Config.Spaces2 -> 2 + Config.Spaces3 -> 3 + Config.Spaces4 -> 4 + + dataTypeParser :: Parser PT.DataTypes + dataTypeParser = + MPCL.nonIndented + spaceAny + ( MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "alias " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (aliasMapper name <. Map.toList <. Map.fromList) + aliasParser + ) + , MPCL.indentBlock spaceAny <| do + voidString "enum " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (enumMapper name <. Map.toList <. Map.fromList) + enumParser + ) + , MPCL.indentBlock spaceAny <| do + voidString "model " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (modelMapper name <. Map.toList <. Map.fromList) + modelParser + ) + , MPCL.indentBlock spaceAny <| do + voidString "constant " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just (MP.mkPos <| 1 + spacePos)) + (constantMapper name <. Map.toList <. Map.fromList) + constantParser + ) + ] + ) + + aliasMapper :: Text -> [(String, PT.AliasParams)] -> Parser PT.DataTypes + aliasMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.AliasMeta m) -> m + _ -> Nothing + ) + + type_ :: Maybe PT.Types + type_ = + ( List.lookup "type" map + |> \case + Just (PT.AliasType t) -> Just t + _ -> Nothing + ) + in case type_ of + Just t -> return <| PT.Alias name meta t + _ -> fail "Insufficient parameters passed to alias type" + + aliasParser :: Parser (String, PT.AliasParams) + aliasParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.AliasMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "type:" + indentWrapper + "type" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.AliasType <. UnsafeList.head) + typeParser + ] + + enumMapper :: Text -> [(String, PT.EnumParams)] -> Parser PT.DataTypes + enumMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.EnumMeta m) -> m + _ -> Nothing + ) + + members :: Maybe [PT.Values] + members = + ( List.lookup "members" map + |> \case + Just (PT.EnumMembers e) -> Just e + _ -> Nothing + ) + in case members of + Just m -> return <| PT.Enum name meta m + _ -> fail "Insufficient parameters passed to enum type" + + enumParser :: Parser (String, PT.EnumParams) + enumParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.EnumMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "members:" + indentWrapper + "members" + (MP.mkPos <| 1 + (spacePos * 2)) + PT.EnumMembers + valueParser + ] + + modelMapper :: Text -> [(String, PT.ModelParams)] -> Parser PT.DataTypes + modelMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.ModelMeta m) -> m + _ -> Nothing + ) + + fields :: Maybe [PT.ModelField] + fields = + ( List.lookup "fields" map + |> \case + Just (PT.ModelFields f) -> Just f + _ -> Nothing + ) + in case fields of + Just f -> return <| PT.Model name meta f + _ -> fail "Insufficient parameters passed to model type" + + modelParser :: Parser (String, PT.ModelParams) + modelParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ModelMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "fields:" + indentWrapper + "fields" + (MP.mkPos <| 1 + (spacePos * 2)) + PT.ModelFields + modelFieldsParser + ] + + modelFieldsParser :: Parser PT.ModelField + modelFieldsParser = + MPCL.lexeme spacer <| + MPCL.indentBlock spaceAny <| + do + voidString "field " + name <- nameParser + MPC.space + colon + return + ( MPCL.IndentMany + (Just <| (MP.mkPos <| 1 + (spacePos * 3))) + (return <. fieldMapper name) + fieldParser + ) + + fieldMapper :: Text -> [PT.Types] -> PT.ModelField + fieldMapper name types = + PT.ModelField name (UnsafeList.head types) + + fieldParser :: Parser PT.Types + fieldParser = + MPCL.lexeme spacer <| + MPCL.indentBlock spaceAny <| + do + voidString "type:" + return + ( MPCL.IndentMany + (Just <| (MP.mkPos <| 1 + (spacePos * 4))) + (return <. UnsafeList.head) + typeParser + ) + + constantMapper :: Text -> [(String, PT.ConstantParams)] -> Parser PT.DataTypes + constantMapper name map = + let meta :: Maybe PT.MetaField + meta = + ( List.lookup "meta" map + |> \case + Just (PT.ConstantMeta m) -> m + _ -> Nothing + ) + + type_ :: Maybe PT.Types + type_ = + ( List.lookup "type" map + |> \case + Just (PT.ConstantType t) -> Just t + _ -> Nothing + ) + + value :: Maybe PT.Values + value = + ( List.lookup "value" map + |> \case + Just (PT.ConstantValue v) -> Just v + _ -> Nothing + ) + in case (type_, value) of + (Just t, Just v) -> return <| PT.Constant name meta t v + _ -> fail "Insufficient parameters passed to constant type" + + constantParser :: Parser (String, PT.ConstantParams) + constantParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "meta:" + indentWrapper + "meta" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ConstantMeta <. metaMapper <. Map.toList <. Map.fromList) + metaParser + , MPCL.indentBlock spaceAny <| do + voidString "type:" + indentWrapper + "type" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ConstantType <. UnsafeList.head) + typeParser + , MPCL.indentBlock spaceAny <| do + voidString "value:" + indentWrapper + "value" + (MP.mkPos <| 1 + (spacePos * 2)) + (PT.ConstantValue <. UnsafeList.head) + valueParser + ] + + metaMapper :: [(String, PT.MetaParams)] -> Maybe PT.MetaField + metaMapper map = + let doc :: Maybe Text + doc = + ( List.lookup "doc" map + |> \case + Just (PT.MetaDoc d) -> d + _ -> Nothing + ) + + ref :: Maybe [(FilePath, [PT.Types])] + ref = + ( List.lookup "ref" map + |> \case + Just (PT.MetaRef r) -> r + _ -> Nothing + ) + + lang :: Maybe [Text] + lang = + ( List.lookup "lang" map + |> \case + Just (PT.MetaLang l) -> l + _ -> Nothing + ) + in case (doc, ref, lang) of + (Nothing, Nothing, Nothing) -> fail "No parameters passed to meta field, but a meta field was opened." + _ -> return <| PT.MetaField doc ref lang + + metaParser :: Parser (String, PT.MetaParams) + metaParser = + MPCL.lexeme spacer <| + MP.choice + [ MPCL.indentBlock spaceAny <| do + voidString "doc:" + indentWrapper + "doc" + (MP.mkPos <| 1 + (spacePos * 3)) + (PT.MetaDoc <. docMapper) + docParser + , MPCL.indentBlock spaceAny <| do + voidString "ref:" + indentWrapper + "ref" + (MP.mkPos <| 1 + (spacePos * 3)) + (PT.MetaRef <. Just) + refParser + , MPCL.indentBlock spaceAny <| do + voidString "lang:" + indentWrapper + "lang" + (MP.mkPos <| 1 + (spacePos * 3)) + (PT.MetaLang <. Just) + langParser + ] + + docMapper :: [Text] -> Maybe Text + docMapper docLines = Just <| List.foldl (\a b -> a <> Text.pack "\n" <> b) (Text.pack "") docLines + + docParser :: Parser Text + docParser = + MPCL.lexeme spacer <| + MP.manyTill MPCL.charLiteral eol + >>= return <. Text.pack + + refParser :: Parser (FilePath, [PT.Types]) + refParser = + MPCL.lexeme spacer <| + do + path <- pathParser + colon + types_ <- MP.sepBy1 definedTypeParser colon + return <| + ( path + , types_ + ) + + langParser :: Parser Text + langParser = langLangParser + + langLangParser :: Parser Text + langLangParser = + MPCL.lexeme spacer <| do + lang <- + MP.choice + [ MPC.string "haskell" + , MPC.string "python" + , MPC.string "elm" + , MPC.string "gleam" + ] + >>= return <. Text.pack + eol + return lang + + typeParser :: Parser PT.Types + typeParser = + let type_ :: Parser PT.Types + type_ = + MP.choice + [ PT.DTTStr <$ MPC.string "Str" + , PT.DTTInt <$ MPC.string "Int" + , PT.DTTFloat <$ MPC.string "Float" + , PT.DTTBool <$ MPC.string "Bool" + , do + voidString "Dict " + PT.DTTDict <$> typeParser + , do + voidString "List " + PT.DTTList <$> typeParser + , do + voidString "Nullable " + PT.DTTNullable <$> typeParser + , do + voidString "Set " + PT.DTTSet <$> typeParser + , do + voidString "Tuple2" + PT.DTTPair + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , do + voidString "Tuple3" + PT.DTTTrio + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , do + voidString "Tuple4" + PT.DTTQuad + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , do + voidString "Tuple5" + PT.DTTQuint + <$> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + <*> do + MPC.char ' ' + typeParser + , definedTypeParser + ] + in ( do + MPC.char '(' + spaceAny + t <- type_ + spaceAny + MPC.char ')' + return t + ) + <|> type_ + + valueParser :: Parser PT.Values + valueParser = + let val = + MP.choice + [ MPC.char '"' + >> MP.manyTill MPCL.charLiteral (MPC.char '"') + >>= return <. PT.VStr + , ( MPCL.signed spaceAny <| + MPCL.lexeme spacer <| + MPCL.decimal + ) + >>= return <. PT.VInt + , ( MPCL.signed spaceAny <| + MPCL.lexeme spacer <| + MPCL.float + ) + >>= return <. PT.VFloat + , MP.choice + [ PT.VBool True <$ MPC.string "True" + , PT.VBool False <$ MPC.string "False" + ] + , MPCL.lexeme spaceAny <| + voidString "Dict" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "[") + (MPCL.symbol spaceAny "]") + ( MP.sepBy + ( MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + k <- + MPC.char '"' + >> MP.manyTill MPCL.charLiteral (MPC.char '"') + voidString ", " + v <- valueParser + return (k, v) + ) + ) + (voidString ", ") + ) + >>= return <. PT.VDict <. Map.fromList + , MPCL.lexeme spaceAny <| + voidString "List" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "[") + (MPCL.symbol spaceAny "]") + (MP.sepBy valueParser (MPC.char ',')) + >>= return <. PT.VList + , MP.choice + [ do + voidString "NotNull " + jVal <- valueParser + return <| PT.VNullable <| Just jVal + , PT.VNullable Nothing <$ voidString "Null" + ] + , MPCL.lexeme spaceAny <| + voidString "Set" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "[") + (MPCL.symbol spaceAny "]") + ( MP.sepBy valueParser (MPC.char ',') + >>= return <. PT.VSet <. Set.fromList + ) + , MPCL.lexeme spaceAny <| + voidString "Tuple2" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + return (a, b) + ) + >>= return <. PT.VTuple2 + , MPCL.lexeme spaceAny <| + voidString "Tuple3" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + c <- valueParser + return (a, b, c) + ) + >>= return <. PT.VTuple3 + , MPCL.lexeme spaceAny <| + voidString "Tuple4" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + c <- valueParser + d <- valueParser + return (a, b, c, d) + ) + >>= return <. PT.VTuple4 + , MPCL.lexeme spaceAny <| + voidString "Tuple5" + >> spaceAny + >> MP.between + (MPCL.symbol spaceAny "{") + (MPCL.symbol spaceAny "}") + ( do + a <- valueParser + b <- valueParser + c <- valueParser + d <- valueParser + e <- valueParser + return (a, b, c, d, e) + ) + >>= return <. PT.VTuple5 + , MPCL.lexeme spaceAny <| + nameParser + >>= return <. PT.OtherValue + ] + in MP.between + (MPCL.symbol spaceAny "(") + (MPCL.symbol spaceAny ")") + val + <|> val + + nameParser :: Parser Text + nameParser = + MPCL.lexeme spacer <| do + first <- MPC.upperChar + rest <- + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + ] + ) + return <| Text.pack (first : rest) + + -- A specific packed version of nameParser + definedTypeParser :: Parser PT.Types -- Specifically (DefinedDataType Text) + definedTypeParser = + MPCL.lexeme spacer <| do + first <- MPC.upperChar + rest <- + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + ] + ) + return <| PT.DefinedDataType <| Text.pack (first : rest) + + pathParser :: Parser FilePath + pathParser = + MPCL.lexeme spacer <| + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + , MPC.char '-' + , MPC.char '/' + , MPC.char '\\' + ] + ) + + pathAsTextParser :: Parser Text + pathAsTextParser = + MPCL.lexeme spacer <| + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + , MPC.char '-' + , MPC.char '/' + , MPC.char '\\' + ] + ) + >>= return <. Text.pack + + anyNameParser :: Parser Text + anyNameParser = + MPCL.lexeme spacer <| do + MP.many + ( MP.choice + [ MPC.alphaNumChar + , MPC.char '_' + ] + ) + >>= return <. Text.pack + + indentWrapper + :: String + -> MP.Pos + -> ([a] -> c) + -> Parser a + -> Parser + ( MPCL.IndentOpt + Parser + (String, c) + a + ) + indentWrapper field pos wrapperMapper parser = + return + ( MPCL.IndentMany + (Just pos) + ( \a -> + return (field, wrapperMapper a) + ) + parser + ) + in MP.someTill + dataTypeParser + MP.eof + +lineComment :: Parser () +lineComment = + MPCL.skipLineComment "#" + +space2 :: Parser () +space2 = + MPCL.space + (replicateM_ 2 (MPC.char ' ')) + lineComment + MP.empty + +space3 :: Parser () +space3 = + MPCL.space + (replicateM_ 3 (MPC.char ' ')) + lineComment + MP.empty + +space4 :: Parser () +space4 = + MPCL.space + (replicateM_ 4 (MPC.char ' ')) + lineComment + MP.empty + +tab :: Parser () +tab = + MPCL.space + (void <| MPC.char '\t') + lineComment + MP.empty + +spaceAny :: Parser () +spaceAny = + MPCL.space + MPC.space1 + lineComment + MP.empty + +eol :: Parser () +eol = void MPC.eol + +colon :: Parser () +colon = void (MPC.char ':') + +voidString :: String -> Parser () +voidString str = void (MPC.string str) + +nullParser :: Parser () +nullParser = return () diff --git a/app/DataTypeTool/Parsing/Raw.hs b/app/DataTypeTool/Parsing/Raw.hs new file mode 100644 index 0000000..3a705d1 --- /dev/null +++ b/app/DataTypeTool/Parsing/Raw.hs @@ -0,0 +1,112 @@ +module DataTypeTool.Parsing.Raw where + +import qualified Antelude.List as List + +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text + + +type RawTypeFile = + RawTypeFile + { refs :: List (FilePath, Text) + , types :: List DataTypes + } + +type DataTypeFile = List DataTypes + +data Type + -- Encodable + = DTTStrG + | DTTIntG + | DTTIntS8 + | DTTIntS16 + | DTTIntS32 + | DTTIntS64 + | DTTIntU8 + | DTTIntU16 + | DTTIntU32 + | DTTIntU64 + | DTTFloatS8 + | DTTFloatS16 + | DTTFloatS32 + | DTTFloatS64 + | DTTFloatU8 + | DTTFloatU16 + | DTTFloatU32 + | DTTFloatU64 + | DTTBool + | DTTList Type + -- Enforced to be "Dict String " + | DTTDict Type + -- Nullability + | DTTNullable Type + -- Not _Normally_ Encodable + | DTTSet Type + | DTTPair Type Type + | DTTTrio Type Type Type + | DTTQuad Type Type Type Type + | DTTQuint Type Type Type Type Type + -- .type-File Defined + | ImportedType Type -- Specifically DefinedDataType + | DefinedDataType Text + deriving (Show) + +data DataTypes + = Alias + { aliasName :: Text + , aliasMeta :: Maybe MetaField + , aliasType :: Type + } + | Enum + { enumName :: Text + , enumMeta :: Maybe MetaField + , enumMembers :: List Values + } + | Model + { modelName :: Text + , modelMeta :: Maybe MetaField + , modelFields :: List ModelField + } + deriving (Show) + +data MetaField + = MetaField + { metaDoc :: Maybe Text + , metaLang :: Maybe (List Text) + } + deriving (Show) + +data MetaParams + = MetaDoc (Maybe Text) + | MetaLang (Maybe (List Text)) + deriving (Show) + +data AliasParams + = AliasName Text + | AliasMeta (Maybe MetaField) + | AliasType Type + deriving (Show) + +data EnumParams + = EnumName Text + | EnumMeta (Maybe MetaField) + | EnumMembers (List Values) + deriving (Show) + +data ModelParams + = ModelName Text + | ModelMeta (Maybe MetaField) + | ModelFields (List ModelField) + deriving (Show) + +data ModelField + = ModelField + { fieldName :: Text + , fieldType :: Types + } + deriving (Show) + +data ModelFieldParams + = FieldName Text + | FieldType Types + deriving (Show) diff --git a/app/DataTypeTool/Parsing/Types.hs b/app/DataTypeTool/Parsing/Types.hs new file mode 100644 index 0000000..2917c1d --- /dev/null +++ b/app/DataTypeTool/Parsing/Types.hs @@ -0,0 +1,119 @@ +module DataTypeTool.Parsing.Types where + +import qualified Antelude.List as List + +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text + +type DataTypeFile = List DataTypes + +data Types + -- Encodable + = DTTStr + | DTTInt + | DTTFloat + | DTTBool + | DTTList Types + | DTTDict Types + -- Nullability + | DTTNullable Types + -- Not _Normally_ Encodable + | DTTSet Types + | DTTPair Types Types + | DTTTrio Types Types Types + | DTTQuad Types Types Types Types + | DTTQuint Types Types Types Types Types + -- .type-File Defined + | ImportedType Types + | DefinedDataType Text + deriving (Show) + +data Values + = VStr String + | VInt Integer + | VFloat Float + | VBool Bool + | VList (List Values) + | VDict (Map String Values) + | VNullable (Maybe Values) + | VSet (Set Values) + | VTuple2 (Values, Values) + | VTuple3 (Values, Values, Values) + | VTuple4 (Values, Values, Values, Values) + | VTuple5 (Values, Values, Values, Values, Values) + | OtherValue Text + deriving (Eq, Ord, Show) + +data DataTypes + = Alias + { aliasName :: Text + , aliasMeta :: Maybe MetaField + , aliasType :: Types + } + | Enum + { enumName :: Text + , enumMeta :: Maybe MetaField + , enumMembers :: List Values + } + | Model + { modelName :: Text + , modelMeta :: Maybe MetaField + , modelFields :: List ModelField + } + | Constant + { constantName :: Text + , constantMeta :: Maybe MetaField + , constantType :: Types + , constantValue :: Values + } + deriving (Show) + +data AliasParams + = AliasMeta (Maybe MetaField) + | AliasType Types + deriving (Show) + +data EnumParams + = EnumName Text + | EnumMeta (Maybe MetaField) + | EnumMembers (List Values) + deriving (Show) + +data ModelParams + = ModelName Text + | ModelMeta (Maybe MetaField) + | ModelFields (List ModelField) + deriving (Show) + +data ConstantParams + = ConstantName Text + | ConstantMeta (Maybe MetaField) + | ConstantType Types + | ConstantValue Values + deriving (Show) + +data MetaField + = MetaField + { metaDoc :: Maybe Text + , metaRef :: Maybe (List (FilePath, List Types)) + , metaLang :: Maybe (List Text) + } + deriving (Show) + +data MetaParams + = MetaDoc (Maybe Text) + | MetaRef (Maybe (List (FilePath, List Types))) + | MetaLang (Maybe (List Text)) + deriving (Show) + +data ModelField + = ModelField + { fieldName :: Text + , fieldType :: Types + } + deriving (Show) + +data ModelFieldParams + = FieldName Text + | FieldType Types + deriving (Show) diff --git a/app/DataTypeTool/Parsing/Valid.hs b/app/DataTypeTool/Parsing/Valid.hs new file mode 100644 index 0000000..eecd968 --- /dev/null +++ b/app/DataTypeTool/Parsing/Valid.hs @@ -0,0 +1 @@ +module DataTypeTool.Parsing.Valid where diff --git a/app/DataTypeTool/Parsing/Validate.hs b/app/DataTypeTool/Parsing/Validate.hs new file mode 100644 index 0000000..fd906f4 --- /dev/null +++ b/app/DataTypeTool/Parsing/Validate.hs @@ -0,0 +1,16 @@ +module DataTypeTool.Parsing.Validate where + +import qualified DataTypeTool.Parsing.Types as PT + +import qualified Text.Megaparsec as MP + +validate + :: [(FilePath, PT.DataTypeFile)] + -> Result + String + [ ( FilePath + , PT.DataTypeFile + ) + ] +validate lstStuff = + Err "" diff --git a/app/Instances.hs b/app/Instances.hs deleted file mode 100644 index 28ac305..0000000 --- a/app/Instances.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Instances where - -import Data.Eq (Eq (..)) -import Data.Ord (Ord (..)) - -instance Eq (a -> b) where - (==) _ _ = True - (/=) _ _ = False - -instance Ord (a -> b) where - compare _ _ = EQ - (<) _ _ = False - (<=) _ _ = True - (>) _ _ = False - (>=) _ _ = True - min _ f2 = f2 - max f1 _ = f1 diff --git a/app/Lang/Elm/Config.hs b/app/Lang/Elm/Config.hs deleted file mode 100644 index 9ebd3d5..0000000 --- a/app/Lang/Elm/Config.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Lang.Elm.Config where - - -import Data.Version (Version) -import Instances -import Parsing.Types (DataTypes) -import Text.Show.Functions - - -data LangConf = - LangConf - { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () - , outputLocation :: FilePath - , langVersion :: Version - } - deriving (Show) diff --git a/app/Lang/Elm/Toml.hs b/app/Lang/Elm/Toml.hs deleted file mode 100644 index 13901d3..0000000 --- a/app/Lang/Elm/Toml.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Lang.Elm.Toml where - - -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import Instances -import Lang.Elm.Config (LangConf (..)) -import Lang.Elm.Writer (elmWriter) -import Text.Show.Functions -import qualified Toml -import Toml ((.=)) - - -confCodec :: Toml.TomlCodec LangConf -confCodec = LangConf - <$> (pure elmWriter) - <*> Toml.string "output_location" .= outputLocation - <*> Extras.versionCodec "lang_version" .= langVersion diff --git a/app/Lang/Elm/Versions/ElmZeroNineteenOne.hs b/app/Lang/Elm/Versions/ElmZeroNineteenOne.hs deleted file mode 100644 index 8d308de..0000000 --- a/app/Lang/Elm/Versions/ElmZeroNineteenOne.hs +++ /dev/null @@ -1,585 +0,0 @@ -module Lang.Elm.Versions.ElmZeroNineteenOne (writer) where - -import qualified Antelude.File as File -import qualified Antelude.List as List -import qualified Antelude.Maybe as Maybe -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import qualified Control.Monad as Monad -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import Lang.Elm.Config (LangConf (..)) -import qualified Parsing.Types as PT -import qualified System.Directory as Dir -import qualified Text.Casing as Case - - - -writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -writer elmConf baseDir = let - path :: FilePath -> FilePath - path pth = (baseDir <> outputLocation elmConf <> elmDirPath pth) - in - Monad.mapM_ - (\(pth, lstType) -> - Com.createWritePath - (baseDir - <> outputLocation elmConf - <> "/DTT/" - <> elmDirPath pth - ) - >> File.writeFile - (baseDir - <> outputLocation elmConf - <> "/DTT/" - <> elmFilePath pth - ) - ( header pth - <> staticImports - <> mapReferencedImports (pth, lstType) - <> "\n\n" - <> typesWriter lstType - ) - ) - -elmDirPath :: FilePath -> FilePath -elmDirPath = - Com.typeFilePathToLangDirPath - Com.PascalCase - - -elmFilePath :: FilePath -> FilePath -elmFilePath = - Com.typeFilePathToLangFilePath - Com.PascalCase - ".elm" - - -elmCodePath :: FilePath -> String -elmCodePath = Com.typeFilePathToLangCodePath - Com.PascalCase - '.' - - -header :: FilePath -> String -header fp = - "module DTT." - <> elmCodePath fp - <> " exposing (..)" - <> "\n\n{- This file was generated by DataTypeTool -}\n\n" - - -staticImports :: String -staticImports = - "import Dict exposing (Dict)\n" - <> "import Set exposing (Set)\n" - <> "import Json.Decode as JD\n" - <> "import Json.Encode as JE\n" - <> "import Json.Decode.Extra as JDE\n" - <> "import Json.Encode.Extra as JEE\n" - <> "import Json.Decode.Pipeline as JDP\n" - - -mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String -mapReferencedImports (_, lstDtaTypes) = let - referencedImports :: [(FilePath, [PT.Types])] -> String - referencedImports metaStuff = - (List.map - (\(fp, lstTypes) -> - "import DTT." - <> elmCodePath fp - <> " exposing (" - <> ( lstTypes - |> List.filter - (\case - PT.DefinedDataTypes _ -> True - _ -> False - ) - |> List.map - (\a -> - typesMap a - -- TODO, need to adjust how "DefinedDataTypes" are stored - -- So I can disambiguate between needing (..) or not here. - <> ", " - <> serializerMap a - <> ", " - <> deserializerMap a - ) - |> List.intersperse ", " - |> List.concat - ) - <> ")" - ) - metaStuff - |> List.intersperse "\n" - |> List.concat - ) - <> "\n" - in - List.map - (\dtaType -> - case dtaType of - PT.Alias _ meta _ -> meta - PT.Enum _ meta _ -> meta - PT.Model _ meta _ -> meta - PT.Constant _ meta _ _ -> meta - |> \case - Just m -> - Maybe.map referencedImports (PT.metaRef m) - |> Maybe.withDefault "" - Nothing -> "" - ) - lstDtaTypes - |> List.filter (/= "") - |> List.intersperse "\n" - |> List.concat - - -docComments :: Maybe PT.MetaField -> String -docComments = \case - Just meta -> - case PT.metaDoc meta of - Just doc -> - "{-\n " - <> ( List.lines (Text.unpack doc) - |> List.filter (/= "") - |> List.intersperse "\n " - |> List.concat - ) - <> "\n-}\n" - Nothing -> "" - Nothing -> "" - - --- serializer :: PT.DataTypes -> String --- serializer (PT.Constant name meta type_ value) = "" --- serializer (PT.Alias name meta type_) = --- ( (Text.unpack name |> Case.camel) --- <> "Encoder : " --- <> (Text.unpack name |> Case.pascal) --- <> " -> JE.Value\n" --- <> (Text.unpack name |> Case.camel) --- <> "Encoder val =\n " --- <> (serializerMap type_) --- <> " val" --- ) --- serializer (PT.Enum name meta members) = --- ( (Text.unpack name |> Case.camel) --- <> "Encoder : " --- <> (Text.unpack name |> Case.pascal) --- <> " -> JE.Value\n" --- <> (Text.unpack name |> Case.camel) --- <> "Encoder val =\n " --- <> "case val of\n " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( (Text.unpack txt) --- <> " -> JE.string \"" --- <> (Case.quietSnake <| Text.unpack txt) --- <> "\"" --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse "\n " --- |> List.concat --- ) --- ) --- serializer (PT.Model name meta fields) = --- ( (Text.unpack name |> Case.camel) --- <> "Encoder : " --- <> (Text.unpack name |> Case.pascal) --- <> " -> JE.Value\n" --- <> (Text.unpack name |> Case.camel) --- <> "Encoder val =" --- <> "\n " --- <> "JE.object\n [ " --- <> ( List.map --- (\field -> --- ( "( \"" --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "\", " --- <> (PT.fieldType field |> serializerMap) --- <> " val." --- <> (PT.fieldName field |> Text.unpack |> Case.camel) --- <> ")" --- ) --- ) --- fields --- |> List.intersperse "\n , " --- |> List.concat --- ) --- <> "\n ]" --- ) - - --- deserializer :: PT.DataTypes -> String --- deserializer (PT.Constant name meta type_ value) = "" --- deserializer (PT.Alias name meta type_) = --- ( (Text.unpack name |> Case.camel) --- <> "Decoder : JD.Decoder " --- <> (Text.unpack name |> Case.pascal) --- <> "\n" --- <> (Text.unpack name |> Case.camel) --- <> "Decoder = " --- <> (deserializerMap type_) --- ) --- deserializer (PT.Enum name meta members) = --- ( (Text.unpack name |> Case.camel) --- <> "Decoder : JD.Decoder " --- <> (Text.unpack name |> Case.pascal) --- <> "\n" --- <> (Text.unpack name |> Case.camel) --- <> "Decoder = JD.string" --- <> "\n |> JD.andThen" --- <> "\n (\\strEnum -> case strEnum of" --- <> "\n " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( "\"" --- <> (Case.quietSnake <| Text.unpack txt) --- <> "\" -> JD.succeed " --- <> (Text.unpack txt) --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse "\n " --- |> List.concat --- ) --- <> "\n _ -> JD.fail \"Could not find matching string for type " --- <> (Text.unpack name |> Case.pascal) --- <> "\"\n )" --- ) --- deserializer (PT.Model name meta fields) = --- ( (Text.unpack name |> Case.camel) --- <> "Decoder : JD.Decoder " --- <> (Text.unpack name |> Case.pascal) --- <> "\n" --- <> (Text.unpack name |> Case.camel) --- <> "Decoder =\n JD.succeed " --- <> (Text.unpack name |> Case.pascal) --- <> "\n " --- <> ( List.map --- (\field -> --- ( "|> JDP.required \"" --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "\" (" --- <> (PT.fieldType field |> deserializerMap) --- <> ")" --- ) --- ) --- fields --- |> List.intersperse "\n " --- |> List.concat --- ) --- ) - - -invTypeWriter :: PT.DataTypes -> String -invTypeWriter (PT.Constant name meta type_ value) = - docComments meta - <> (Text.unpack name |> Case.camel) - <> " : " - <> typesMap type_ - <> "\n" - <> (Text.unpack name |> Case.camel) - <> " = " - <> valuesMap value - -invTypeWriter (PT.Alias name meta type_) = - docComments meta - <> "type alias " - <> (Text.unpack name |> Case.pascal) - <> " = " - <> typesMap type_ - <> "\n\n\n" - -- <> serializer (PT.Alias name meta type_) - <> "\n\n\n" - -- <> deserializer (PT.Alias name meta type_) - -invTypeWriter (PT.Enum name meta members) = - docComments meta - <> "type " - <> (Text.unpack name |> Case.pascal) - <> "\n = " - <> ( members - |> List.map (\m -> valuesMap m |> Case.pascal) - |> List.intersperse "\n | " - |> List.concat - ) - <> "\n\n\n" - -- <> serializer (PT.Enum name meta members) - <> "\n\n\n" - -- <> deserializer (PT.Enum name meta members) - -invTypeWriter (PT.Model name meta fields) = - docComments meta - <> "type alias " - <> (Text.unpack name |> Case.pascal) - <> " =\n" - <> " { " - <> ( fields - |> List.map - (\f -> - (Text.unpack (PT.fieldName f) |> Case.camel) - <> " : " - <> typesMap (PT.fieldType f) - ) - |> List.intersperse "\n , " - |> List.concat - ) - <> "\n }" - <> "\n\n\n" - -- <> serializer (PT.Model name meta fields) - <> "\n\n\n" - -- <> deserializer (PT.Model name meta fields) - - - -typesWriter :: [PT.DataTypes] -> String -typesWriter types = - List.map invTypeWriter types - |> List.intersperse "\n\n\n" - |> List.concat - - - -typesMap :: PT.Types -> String -typesMap = \case - PT.DTTStr -> "String" - PT.DTTInt -> "Int" - PT.DTTFloat -> "Float" - PT.DTTBool -> "Bool" - PT.DTTList a -> "List " <> typesMap a - PT.DTTDict b -> "Dict String " <> typesMap b - PT.DTTNullable a -> "Maybe " <> typesMap a - PT.DTTSet a -> "Set " <> typesMap a - PT.DTTTuple2 a b -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ")" - PT.DTTTuple3 a b c -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ")" - PT.DTTTuple4 a b c d -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ")" - PT.DTTTuple5 a b c d e -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ", " - <> typesMap e - <> ")" - PT.DefinedDataTypes t -> Text.unpack t |> Case.pascal - - -valuesMap :: PT.Values -> String -valuesMap = \case - PT.VStr str -> "\"" <> str <> "\"" - PT.VInt int -> show int - PT.VFloat flt -> show flt - PT.VBool bl -> show bl - PT.VList lst -> - "[" - <> ( List.map valuesMap lst - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VDict map -> - "Dict.fromList [" - <> ( List.map - (\(k, v) -> - "(\"" - <> k - <> "\", " - <> valuesMap v - <> ")" - ) - (Map.toList map) - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VNullable nll -> case nll of - Just j -> "Just " <> valuesMap j - Nothing -> "Nothing" - PT.VSet set -> - "Set.fromList [" - <> ( List.map valuesMap (Set.toList set) - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VTuple2 (a, b) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ")" - PT.VTuple3 (a, b, c) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ")" - PT.VTuple4 (a, b, c, d) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ")" - PT.VTuple5 (a, b, c, d, e) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ", " - <> valuesMap e - <> ")" - PT.OtherValue t -> Text.unpack t |> Case.pascal - - -serializerMap :: PT.Types -> String -serializerMap = \case - PT.DTTStr -> "(JE.string)" - PT.DTTInt -> "(JE.int)" - PT.DTTFloat -> "(JE.float)" - PT.DTTBool -> "(JE.bool)" - PT.DTTList a -> "(JE.list (" <> serializerMap a <> "))" - PT.DTTDict v -> "(JE.dict identity ("<> serializerMap v <> "))" - PT.DTTNullable a -> "(JEE.maybe (" <> serializerMap a <> "))" - PT.DTTSet a -> - "(\\a -> JE.object [(\"set\", " - <> serializerMap a - <> "(Set.fromList a))) " - PT.DTTTuple2 a b -> - "(\\(a, b) -> JE.object [(\"first\", " - <> serializerMap a - <> " a), (\"second\", " - <> serializerMap b - <> " b)])" - PT.DTTTuple3 a b c -> - "(\\(a, b, c) -> JE.object [(\"first\", " - <> serializerMap a - <> " a), (\"second\", " - <> serializerMap b - <> " b), (\"third\", " - <> serializerMap c - <> " c)])" - PT.DTTTuple4 a b c d -> - "(\\(a, b, c, d) -> JE.object [(\"first\", " - <> serializerMap a - <> " a), (\"second\", " - <> serializerMap b - <> " b), (\"third\", " - <> serializerMap c - <> " c), (\"fourth\", " - <> serializerMap d - <> " d)])" - PT.DTTTuple5 a b c d e -> - "(\\(a, b, c, d, e) -> JE.object [(\"first\", " - <> serializerMap a - <> " a), (\"second\", " - <> serializerMap b - <> " b), (\"third\", " - <> serializerMap c - <> " c), (\"fourth\", " - <> serializerMap d - <> " d), (\"fifth\", " - <> serializerMap e - <> " e)])" - PT.DefinedDataTypes txt -> Text.unpack txt |> Case.camel |> (<> "Encoder") - - -deserializerMap :: PT.Types -> String -deserializerMap = \case - PT.DTTStr -> "(JD.string)" - PT.DTTInt -> "(JD.int)" - PT.DTTFloat -> "(JD.float)" - PT.DTTBool -> "(JD.bool)" - PT.DTTList a -> "(JD.list (" <> deserializerMap a <> "))" - PT.DTTDict v -> "(JD.dict (" <> deserializerMap v <> "))" - PT.DTTNullable a -> "(JD.nullable " <> deserializerMap a <> ")" - PT.DTTSet a -> - "(JD.map Set.fromList" - <> " (JD.field \"set\" (JD.list (" - <> deserializerMap a - <> "))))" - PT.DTTTuple2 a b -> - "(JD.map2 (\\a b -> (a, b))" - <> " (JD.field \"first\" (" - <> deserializerMap a - <> ")) (JD.field \"second\" (" - <> deserializerMap b - <>")))" - PT.DTTTuple3 a b c -> - "(JD.map3 (\\a b c -> (a, b, c))" - <> " (JD.field \"first\" (" - <> deserializerMap a - <> ")) (JD.field \"second\" (" - <> deserializerMap b - <> ")) (JD.field \"third\" (" - <> deserializerMap c - <>")))" - PT.DTTTuple4 a b c d -> - "(JD.map4 (\\a b c d -> (a, b, c, d))" - <> " (JD.field \"first\" (" - <> deserializerMap a - <> ")) (JD.field \"second\" (" - <> deserializerMap b - <> ")) (JD.field \"third\" (" - <> deserializerMap c - <> ")) (JD.field \"fourth\" (" - <> deserializerMap d - <>")))" - PT.DTTTuple5 a b c d e -> - "(JD.map5 (\\a b c d e -> (a, b, c, d, e))" - <> " (JD.field \"first\" (" - <> deserializerMap a - <> ")) (JD.field \"second\" (" - <> deserializerMap b - <> ")) (JD.field \"third\" (" - <> deserializerMap c - <> ")) (JD.field \"fourth\" (" - <> deserializerMap d - <> ")) (JD.field \"fifth\" (" - <> deserializerMap e - <>")))" - PT.DefinedDataTypes txt -> Text.unpack txt |> Case.camel |> (<> "Decoder") diff --git a/app/Lang/Elm/Writer.hs b/app/Lang/Elm/Writer.hs deleted file mode 100644 index c38aa34..0000000 --- a/app/Lang/Elm/Writer.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Lang.Elm.Writer where - - -import qualified Common.Utils as Com -import Data.Version (Version, makeVersion, - showVersion) -import Lang.Elm.Config (LangConf (..)) -import qualified Lang.Elm.Versions.ElmZeroNineteenOne as E0_19_1 -import qualified Parsing.Types as PT - -elmWriter :: Lang.Elm.Config.LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -elmWriter langConf path typeData = let - elmV = langVersion langConf - in - if | elmV >= makeVersion [0, 19, 0] -> E0_19_1.writer langConf path typeData - | otherwise -> - print ("Unable to make out the correct writer for the specified Elm version" <> showVersion elmV) diff --git a/app/Lang/Gleam/Config.hs b/app/Lang/Gleam/Config.hs deleted file mode 100644 index e23d6d1..0000000 --- a/app/Lang/Gleam/Config.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Lang.Gleam.Config where - -import Data.Version (Version) -import Instances -import Parsing.Types (DataTypes) -import Text.Show.Functions - -data GleamBackend - = GleamErlang - | GleamJS - deriving (Show, Eq, Ord) - -data LangConf = - LangConf - { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () - , outputLocation :: FilePath - , langVersion :: Version - , preferredBackend :: GleamBackend - } - deriving (Show) diff --git a/app/Lang/Gleam/Toml.hs b/app/Lang/Gleam/Toml.hs deleted file mode 100644 index 2b97d13..0000000 --- a/app/Lang/Gleam/Toml.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Lang.Gleam.Toml where - - -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import Instances -import Lang.Gleam.Config (GleamBackend (..), LangConf (..)) -import Lang.Gleam.Writer (gleamWriter) -import Text.Show.Functions -import qualified Toml -import Toml ((.=)) - - -backendCodec :: Toml.Key -> Toml.TomlCodec GleamBackend -backendCodec key = let - strToBackend :: String -> GleamBackend - strToBackend ("erlang") = GleamErlang - strToBackend ("javascript") = GleamJS - - backendToStr :: GleamBackend -> String - backendToStr (GleamErlang) = "erlang" - backendToStr (GleamJS) = "javascript" - in - Toml.dimap - backendToStr - strToBackend - (Toml.string key) - -confCodec :: Toml.TomlCodec LangConf -confCodec = LangConf - <$> pure gleamWriter - <*> Toml.string "output_location" .= outputLocation - <*> Extras.versionCodec "lang_version" .= langVersion - <*> backendCodec "preferred_backend" .= preferredBackend diff --git a/app/Lang/Gleam/Versions/GleamOneZeroZero.hs b/app/Lang/Gleam/Versions/GleamOneZeroZero.hs deleted file mode 100644 index f1e1a3e..0000000 --- a/app/Lang/Gleam/Versions/GleamOneZeroZero.hs +++ /dev/null @@ -1,634 +0,0 @@ -module Lang.Gleam.Versions.GleamOneZeroZero (writer) where - -import qualified Antelude.File as File -import qualified Antelude.List as List -import qualified Antelude.Maybe as Maybe -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import qualified Control.Monad as Monad -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import Lang.Gleam.Config (LangConf (..)) -import qualified Parsing.Types as PT -import qualified System.Directory as Dir -import qualified Text.Casing as Case - - - -writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -writer gleamConf baseDir = let - path :: FilePath -> FilePath - path pth = (baseDir <> outputLocation gleamConf <> gleamDirPath pth) - in - Monad.mapM_ - (\(pth, lstType) -> - Dir.createDirectoryIfMissing - True - ( baseDir - <> outputLocation gleamConf - <> "/dtt/" - <> gleamDirPath pth - ) - >> File.writeFile - ( baseDir - <> outputLocation gleamConf - <> "/dtt/" - <> gleamFilePath pth - ) - ( header - <> staticImports - <> mapReferencedImports (pth, lstType) - <> "\n\n" - <> ( List.map - invTypeWriter - lstType - |> List.intersperse "\n\n\n" - |> List.concat - ) - ) - ) - -gleamDirPath :: FilePath -> FilePath -gleamDirPath = Com.typeFilePathToLangDirPath - Com.QuietSnakeCase - -gleamFilePath :: FilePath -> FilePath -gleamFilePath = Com.typeFilePathToLangFilePath - Com.QuietSnakeCase - ".gleam" - --- for the header of files, imports, etc -gleamCodePath :: FilePath -> String -gleamCodePath = Com.typeFilePathToLangCodePath - Com.QuietSnakeCase - '/' - - -header :: String -header = - "//// This file was generated by DataTypeTool\n\n" - - -staticImports :: String -staticImports = - "import gleam/dict.{type Dict}\n" - <> "import gleam/set.{type Set}\n" - <> "import gleam/dynamic.{type Dynamic, type DecodeError}\n" - <> "import gleam/json.{type Json}\n" - <> "import gleam/option.{type Option}\n" - <> "import gleam/result.{try}\n" - -mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String -mapReferencedImports (_, lstDtaTypes) = let - referencedImports :: [(FilePath, [PT.Types])] -> String - referencedImports metaStuff = - (List.map - (\(fp, lstTypes) -> - "import dtt/" - <> gleamCodePath fp - <> ".{" - <> ( lstTypes - |> List.map - (\case - PT.DefinedDataTypes txt -> - "type " - <> (typesMap <| PT.DefinedDataTypes txt) - <> ", " - <> (txt |> Text.unpack |> Case.quietSnake) - <> "_encoder, " - <> (deserializerMap <| PT.DefinedDataTypes txt) - _ -> "" - ) - |> List.filter (/= "") - |> List.intersperse ", " - |> List.concat - ) - <> "}" - ) - metaStuff - |> List.intersperse "\n" - |> List.concat - ) - <> "\n" - in - List.map - (\dtaType -> - case dtaType of - PT.Alias _ meta _ -> meta - PT.Enum _ meta _ -> meta - PT.Model _ meta _ -> meta - PT.Constant _ meta _ _ -> meta - |> \case - Just m -> - Maybe.map referencedImports (PT.metaRef m) - |> Maybe.withDefault "" - Nothing -> "" - ) - lstDtaTypes - |> List.filter (/= "") - |> List.intersperse "\n" - |> List.concat - - -docComments :: Maybe PT.MetaField -> String -docComments = \case - Just meta -> - case PT.metaDoc meta of - Just doc -> - "/// " - <> (List.lines (Text.unpack doc) - |> List.filter (/= "") - |> List.intersperse "\n/// " - |> List.concat - ) - <> "\n" - Nothing -> "" - Nothing -> "" - - --- serializer :: PT.DataTypes -> String --- serializer (PT.Constant name meta type_ value) = "" --- serializer (PT.Alias name meta type_) = --- "pub fn " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_encoder(" --- <> (Text.unpack name |> Case.quietSnake) --- <> ": " --- <> (Text.unpack name |> Case.pascal) --- <> ") -> Json {" --- <> "\n " --- <> (serializerMap type_) --- <> "(" --- <> (Text.unpack name |> Case.quietSnake) --- <> ")" --- <> "\n}" --- serializer (PT.Enum name meta members) = --- "pub fn " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_encoder(" --- <> (Text.unpack name |> Case.quietSnake) --- <> ": " --- <> (Text.unpack name |> Case.pascal) --- <> ") -> Json {" --- <> "\n case " --- <> (Text.unpack name |> Case.quietSnake) --- <> " {\n " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( (Text.unpack txt |> Case.pascal) --- <> " -> json.string(\"" --- <> (Text.unpack txt |> Case.quietSnake) --- <> "\")" --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse "\n " --- |> List.concat --- ) --- <> "\n }" --- <> "\n}" --- serializer (PT.Model name meta fields) = --- "pub fn " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_encoder(" --- <> (Text.unpack name |> Case.quietSnake) --- <> ": " --- <> (Text.unpack name |> Case.pascal) --- <> ") -> Json {" --- <> "\n json.object([" --- <> "\n " --- <> ( List.map --- (\field -> --- ( "#(\"" --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "\", " --- <> (PT.fieldType field |> serializerMap) --- <> "(" --- <> (Text.unpack name |> Case.quietSnake) --- <> "." --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "))" --- ) --- ) --- fields --- |> List.intersperse ",\n " --- |> List.concat --- ) --- <> "\n ])" --- <> "\n}" - - --- deserializer :: PT.DataTypes -> String --- deserializer (PT.Constant name meta type_ value) = "" --- deserializer (PT.Alias name meta type_) = --- "pub fn " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_decoder(json: Dynamic) -> Result(" --- <> (Text.unpack name |> Case.pascal) --- <> ", List(DecodeError)) {" --- <> "\n " --- <> (deserializerMap type_) --- <> "(json)\n}" --- deserializer (PT.Enum name meta members) = --- "pub fn " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_decoder(json: Dynamic) -> Result(" --- <> (Text.unpack name |> Case.pascal) --- <> ", List(DecodeError)) {" --- <> "\n use enum_str <- result.try(dynamic.string(json))" --- <> "\n case enum_str {" --- <> "\n " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( "\"" --- <> (Text.unpack txt |> Case.quietSnake) --- <> "\" -> Ok(" --- <> (Text.unpack txt |> Case.pascal) --- <> ")" --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse "\n " --- |> List.concat --- ) --- <> "\n err -> Error(" --- <> "\n [dynamic.DecodeError(" --- <> "\n \"Expected one of: " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( "\\\"" --- <> (Text.unpack txt |> Case.quietSnake) --- <> "\\\"" --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse ", " --- |> List.concat --- ) --- <> "\"," --- <> "\n \"Found: \" <> err," --- <> "\n []" --- <> "\n )]" --- <> "\n )" --- <> "\n }" --- <> "\n}" --- deserializer (PT.Model name meta fields) = --- "pub fn " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_decoder(json: Dynamic) -> Result(" --- <> (Text.unpack name |> Case.pascal) --- <> ", List(DecodeError)) {" --- <> ( List.map --- (\field -> --- ( "\n use " --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> " <- try(dynamic.field(\"" --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "\", " --- <> (PT.fieldType field |> deserializerMap) --- <> ")(json))" --- ) --- ) --- fields --- |> List.concat --- ) --- <> "\n Ok(" --- <> (Text.unpack name |> Case.pascal) --- <> "(" --- <> ( List.map --- (\field -> --- (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- ) --- fields --- |> List.intersperse ", " --- |> List.concat --- ) --- <> "))\n}" - - -invTypeWriter :: PT.DataTypes -> String -invTypeWriter (PT.Constant name meta type_ value) = - docComments meta - <> "/// Temporarily a function solely because Dict's cant be constructed free-hand.\n" - <> "pub fn " - <> (Text.unpack name |> Case.quietSnake) - <> "() -> " - <> typesMap type_ - <> " {" - <> valuesMap value - <> "}" - -- ( docComments meta - -- <> "pub const " - -- <> (Text.unpack name |> Case.quietSnake) - -- <> ": " - -- <> (typesMap type_) - -- <> " = " - -- <> (valuesMap value) - -- ) -invTypeWriter (PT.Alias name meta type_) = - docComments meta - <> "pub type " - <> (Text.unpack name |> Case.pascal) - <> " = " - <> typesMap type_ - <> "\n\n\n" - -- <> serializer (PT.Alias name meta type_) - <> "\n\n\n" - -- <> deserializer (PT.Alias name meta type_) -invTypeWriter (PT.Enum name meta members) = - "pub type " - <> (Text.unpack name |> Case.pascal) - <> " {\n " - <> ( members - |> List.map (\m -> valuesMap m |> Case.pascal) - |> List.intersperse "\n " - |> List.concat - ) - <> "\n}" - <> "\n\n\n" - -- <> serializer (PT.Enum name meta members) - <> "\n\n\n" - -- <> deserializer (PT.Enum name meta members) -invTypeWriter (PT.Model name meta fields) = - docComments meta - <> "pub type " - <> (Text.unpack name |> Case.pascal) - <> " {\n " - <> (Text.unpack name |> Case.pascal) - <> "(\n " - <> ( fields - |> List.map - (\f -> - (Text.unpack (PT.fieldName f) |> Case.quietSnake) - <> ": " - <> typesMap (PT.fieldType f) - ) - |> List.intersperse ",\n " - |> List.concat - ) - <> "\n )\n}" - <> "\n\n\n" - -- <> serializer (PT.Model name meta fields) - <> "\n\n\n" - -- <> deserializer (PT.Model name meta fields) - - -typesWriter :: [PT.DataTypes] -> String -typesWriter types = - List.map invTypeWriter types - |> List.intersperse "\n\n\n" - |> List.concat - - -typesMap :: PT.Types -> String -typesMap = \case - PT.DTTStr -> "String" - PT.DTTInt -> "Int" - PT.DTTFloat -> "Float" - PT.DTTBool -> "Bool" - PT.DTTList a -> "List(" <> typesMap a <> ")" - PT.DTTDict b -> "Dict(String, " <> typesMap b <> ")" - PT.DTTNullable a -> "Option(" <> typesMap a <> ")" - PT.DTTSet a -> "Set(" <> typesMap a <> ")" - PT.DTTTuple2 a b -> - "#(" - <> typesMap a - <> ", " - <> typesMap b - <> ")" - PT.DTTTuple3 a b c -> - "#(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ")" - PT.DTTTuple4 a b c d -> - "#(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ")" - PT.DTTTuple5 a b c d e -> - "#(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ", " - <> typesMap e - <> ")" - PT.DefinedDataTypes t -> Text.unpack t |> Case.pascal - -valuesMap :: PT.Values -> String -valuesMap = \case - PT.VStr str -> "\"" <> str <> "\"" - PT.VInt int -> show int - PT.VFloat flt -> show flt - PT.VBool bl -> show bl - PT.VList lst -> - "[" - <> ( List.map valuesMap lst - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VDict map -> - -- ToDo: Dict value constructor does not exist. - "dict.from_list([" - <> ( List.map - (\(k, v) -> - "#(\"" - <> k - <> "\", " - <> valuesMap v - <> ")" - ) - (Map.toList map) - |> List.intersperse ", " - |> List.concat - ) - <> "])" - PT.VNullable nll -> case nll of - Just j -> "Some(" <> valuesMap j <> ")" - Nothing -> "None" - PT.VSet set -> - "Set.fromList [" - <> ( List.map valuesMap (Set.toList set) - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VTuple2 (a, b) -> - "#(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ")" - PT.VTuple3 (a, b, c) -> - "#(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ")" - PT.VTuple4 (a, b, c, d) -> - "#(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ")" - PT.VTuple5 (a, b, c, d, e) -> - "#(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ", " - <> valuesMap e - <> ")" - PT.OtherValue t -> Text.unpack t |> Case.pascal - - -serializerMap :: PT.Types -> String -serializerMap = \case - PT.DTTStr -> "json.string" - PT.DTTInt -> "json.int" - PT.DTTFloat -> "json.float" - PT.DTTBool -> "json.bool" - PT.DTTList a -> "fn(l){json.array(l, " <> serializerMap a <> ")}" - PT.DTTDict v -> "fn(d){json.object(dict.map_values(d, fn(_,v){"<> serializerMap v <> "(v)}) |> dict.to_list)}" - PT.DTTNullable a -> "fn(n){json.nullable(n, " <> serializerMap a <> ")}" - PT.DTTSet a -> - "fn(s){json.object([#(\"set\", json.array(set.to_list(s), " - <> serializerMap a - <> "))])}" - PT.DTTTuple2 a b -> - "fn(t){let #(a,b) = t json.object([" - <> "#(\"first\", " - <> serializerMap a - <> "(a)), #(\"second\", " - <> serializerMap b - <> "(b))])}" - PT.DTTTuple3 a b c -> - "fn(t){let #(a,b,c) = t json.object([" - <> "#(\"first\", " - <> serializerMap a - <> "(a)), #(\"second\", " - <> serializerMap b - <> "(b)), #(\"third\", " - <> serializerMap c - <> "(c))])}" - PT.DTTTuple4 a b c d -> - "fn(t){let #(a,b,c,d) = t json.object([" - <> "#(\"first\", " - <> serializerMap a - <> "(a)), #(\"second\", " - <> serializerMap b - <> "(b)), #(\"third\", " - <> serializerMap c - <> "(c)), #(\"fourth\", " - <> serializerMap d - <> "(d))])}" - PT.DTTTuple5 a b c d e -> - "fn(t){let #(a,b,c,d,e) = t json.object([" - <> "#(\"first\", " - <> serializerMap a - <> "(a)), #(\"second\", " - <> serializerMap b - <> "(b)), #(\"third\", " - <> serializerMap c - <> "(c)), #(\"fourth\", " - <> serializerMap d - <> "(d)), #(\"fifth\", " - <> serializerMap e - <> "(e))])}" - PT.DefinedDataTypes txt -> (Text.unpack txt |> Case.quietSnake) <> "_encoder" - - -deserializerMap :: PT.Types -> String -deserializerMap = \case - PT.DTTStr -> "dynamic.string" - PT.DTTInt -> "dynamic.int" - PT.DTTFloat -> "dynamic.float" - PT.DTTBool -> "dynamic.bool" - PT.DTTList a -> "dynamic.list(" <> deserializerMap a <> ")" - PT.DTTDict v -> "dynamic.dict(dynamic.string, " <> deserializerMap v <> ")" - PT.DTTNullable a -> "dynamic.optional(" <> deserializerMap a <> ")" - PT.DTTSet a -> - "fn(setjson){use s <- try(fn(s){dynamic.field(\"set\", dynamic.list(" - <> deserializerMap a - <> "))(setjson) |> result.map(set.from_list)}) Ok(s)}" - PT.DTTTuple2 a b -> - "fn(t2json){use a <- try(dynamic.field(\"first\", " - <> deserializerMap a - <> ")(t2json))" - <> " use b <- try(dynamic.field(\"second\", " - <> deserializerMap b - <> ")(t2json)) Ok(#(a, b))}" - PT.DTTTuple3 a b c -> - "fn(t3json){use a <- try(dynamic.field(\"first\", " - <> deserializerMap a - <> ")(t3json))" - <> " use b <- try(dynamic.field(\"second\", " - <> deserializerMap b - <> ")(t3json))" - <> " use c <- try(dynamic.field(\"third\", " - <> deserializerMap c - <> ")(t3json)) Ok(#(a, b, c))}" - PT.DTTTuple4 a b c d -> - "fn(t4json){use a <- try(dynamic.field(\"first\", " - <> deserializerMap a - <> ")(t4json))" - <> " use b <- try(dynamic.field(\"second\", " - <> deserializerMap b - <> ")(t4json))" - <> " use b <- try(dynamic.field(\"third\", " - <> deserializerMap c - <> ")(t4json))" - <> " use d <- try(dynamic.field(\"fourth\", " - <> deserializerMap d - <> ")(t4json)) Ok(#(a, b, c, d))}" - PT.DTTTuple5 a b c d e -> - "fn(t5json){use a <- try(dynamic.field(\"first\", " - <> deserializerMap a - <> ")(t5json))" - <> " use b <- try(dynamic.field(\"second\", " - <> deserializerMap b - <> ")(t5json))" - <> " use c <- try(dynamic.field(\"third\", " - <> deserializerMap c - <> ")(t5json))" - <> " use d <- try(dynamic.field(\"fourth\", " - <> deserializerMap d - <> ")(t5json))" - <> " use e <- try(dynamic.field(\"fifth\", " - <> deserializerMap e - <> ")(t5json)) Ok(#(a, b, c, d, e))}" - PT.DefinedDataTypes txt -> Text.unpack txt |> Case.quietSnake |> (<> "_decoder") diff --git a/app/Lang/Gleam/Writer.hs b/app/Lang/Gleam/Writer.hs deleted file mode 100644 index b6a9a59..0000000 --- a/app/Lang/Gleam/Writer.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Lang.Gleam.Writer where - - -import qualified Common.Utils as Com -import Data.Version (Version, makeVersion, - showVersion) -import Lang.Gleam.Config (LangConf (..)) -import Lang.Gleam.Versions.GleamOneZeroZero as G1_0_0 -import qualified Parsing.Types as PT - -gleamWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -gleamWriter langConf path typeData = let - gleamV = langVersion langConf - in - if | gleamV >= makeVersion [1, 0, 0] -> G1_0_0.writer langConf path typeData - | otherwise -> - print ("Unable to make out the correct writer for the specified Gleam version: " <> showVersion gleamV) diff --git a/app/Lang/Haskell/Config.hs b/app/Lang/Haskell/Config.hs deleted file mode 100644 index aecf1ea..0000000 --- a/app/Lang/Haskell/Config.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Lang.Haskell.Config where - -import Data.Version (Version) -import Instances -import Parsing.Types (DataTypes) -import Text.Show.Functions - -data LangConf = - LangConf - { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () - , outputLocation :: FilePath - , langVersion :: Version - , useTextOverString :: Bool - } - deriving (Show) diff --git a/app/Lang/Haskell/Toml.hs b/app/Lang/Haskell/Toml.hs deleted file mode 100644 index 7d9f1e6..0000000 --- a/app/Lang/Haskell/Toml.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Lang.Haskell.Toml where - -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import qualified Data.Maybe as Maybe -import Instances -import Lang.Haskell.Config (LangConf (..)) -import Lang.Haskell.Writer (haskellWriter) -import Text.Show.Functions -import qualified Toml -import Toml ((.=)) - -confCodec :: Toml.TomlCodec LangConf -confCodec = LangConf - <$> pure haskellWriter - <*> Toml.string "output_location" .= outputLocation - <*> Extras.versionCodec "lang_version" .= langVersion - <*> ( Toml.dioptional (Toml.bool "use_text_over_string") - |> Toml.dimap - (Just) - (Maybe.fromMaybe False) - ) .= useTextOverString diff --git a/app/Lang/Haskell/Versions/GHCNineEightOne.hs b/app/Lang/Haskell/Versions/GHCNineEightOne.hs deleted file mode 100644 index f4af871..0000000 --- a/app/Lang/Haskell/Versions/GHCNineEightOne.hs +++ /dev/null @@ -1,598 +0,0 @@ -module Lang.Haskell.Versions.GHCNineEightOne (writer) where - -import qualified Antelude.File as File -import qualified Antelude.List as List -import qualified Antelude.Maybe as Maybe -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import qualified Control.Monad as Monad -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import Lang.Haskell.Config (LangConf (..)) -import qualified Parsing.Types as PT -import qualified System.Directory as Dir -import qualified Text.Casing as Case - - - -writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -writer haskellConf baseDir = let - path :: FilePath -> FilePath - path pth = (baseDir <> outputLocation haskellConf <> haskellDirPath pth) - in - Monad.mapM_ - (\(pth, lstType) -> - Com.createWritePath - (baseDir - <> outputLocation haskellConf - <> "/DTT/" - <> haskellDirPath pth - ) - >> File.writeFile - (baseDir - <> outputLocation haskellConf - <> "/DTT/" - <> haskellFilePath pth - ) - ( header pth - <> staticImports - <> mapReferencedImports (pth, lstType) - <> "\n\n" - <> typesWriter lstType - ) - ) - -haskellDirPath :: FilePath -> FilePath -haskellDirPath = Com.typeFilePathToLangDirPath - Com.PascalCase - -haskellFilePath :: FilePath -> FilePath -haskellFilePath = Com.typeFilePathToLangFilePath - Com.PascalCase - ".hs" - -haskellCodePath :: FilePath -> String -haskellCodePath = Com.typeFilePathToLangCodePath - Com.PascalCase - '.' - - -header :: FilePath -> String -header fp = - "module DTT." - <> haskellCodePath fp - <> " where" - <> "\n\n{- This file was generated by DataTypeTool -}\n\n" - -staticImports :: String -staticImports = - "import Data.Map.Strict (Map)\n" - <> "import qualified Data.Map.Strict as Map\n" - <> "import Data.Set (Set)\n" - <> "import qualified Data.Set as Set\n" - <> "import Data.String (fromString)\n" - <> "import Data.Text (Text)\n" - <> "import qualified Data.Text as Text\n" - <> "import qualified Data.Aeson as Aeson\n" - <> "import qualified Data.Aeson.Types as AesonT\n" - <> "import Data.Function ((&))\n" - <> "import Control.Applicative ((<|>))\n" - <> "import Control.Monad.Fail (fail)\n" - -mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String -mapReferencedImports (_, lstDtaTypes) = let - referencedImports :: [(FilePath, [PT.Types])] -> String - referencedImports metaStuff = - (List.map - (\(fp, lstTypes) -> - "import DTT." - <> haskellCodePath fp - ) - metaStuff - |> List.intersperse "\n" - |> List.concat - ) - <> "\n" - in - List.map - (\dtaType -> - case dtaType of - PT.Alias _ meta _ -> meta - PT.Enum _ meta _ -> meta - PT.Model _ meta _ -> meta - PT.Constant _ meta _ _ -> meta - |> \case - Just m -> - Maybe.map referencedImports (PT.metaRef m) - |> Maybe.withDefault "" - Nothing -> "" - ) - lstDtaTypes - |> List.filter (/= "") - |> List.intersperse "\n" - |> List.concat - - -docComments :: Maybe PT.MetaField -> String -docComments = \case - Just meta -> - case PT.metaDoc meta of - Just doc -> - "{- |\n " - <> ( List.lines (Text.unpack doc) - |> List.filter (/= "") - |> List.intersperse "\n " - |> List.concat - ) - <> "\n-}\n" - Nothing -> "" - Nothing -> "" - - -serializer :: PT.DataTypes -> String -serializer (PT.Constant name meta type_ value) = "" -serializer (PT.Alias name meta type_) = - (Text.unpack name |> Case.camel) - <> "Encoder :: " - <>(Text.unpack name |> Case.pascal) - <> " -> AesonT.Value\n" - <> (Text.unpack name |> Case.camel) - <> "Encoder = " - <> serializerMap type_ -serializer (PT.Enum name meta members) = - (Text.unpack name |> Case.camel) - <> "Encoder :: " - <>(Text.unpack name |> Case.pascal) - <> " -> AesonT.Value\n" - <> (Text.unpack name |> Case.camel) - <> "Encoder t = case t of\n " - <> ( List.map - (\case - PT.OtherValue txt -> - ( Text.unpack txt - <> " -> Aeson.toJSON \"" - <> (Case.quietSnake <| Text.unpack txt) - <> "\"" - ) - _ -> "" - ) - members - |> List.filter (/= "") - |> List.intersperse "\n " - |> List.concat - ) -serializer (PT.Model name meta fields) = - (Text.unpack name |> Case.camel) - <> "Encoder :: " - <>(Text.unpack name |> Case.pascal) - <> " -> AesonT.Value\n" - <> (Text.unpack name |> Case.camel) - <> "Encoder val = Aeson.object" - <> "\n [ " - <> ( List.map - (\field -> - "(fromString \"" - <> (Case.quietSnake <| Text.unpack <| PT.fieldName field) - <> "\" :: Aeson.Key) Aeson..= (" - <> (Text.unpack name |> Case.camel) - <> (Text.unpack (PT.fieldName field) |> Case.pascal) - <> " val |> " - <> (serializerMap <| PT.fieldType field) - <> ")" - ) - fields - |> List.intersperse "\n , " - |> List.concat - ) - <> "\n ]" - - -deserializer :: PT.DataTypes -> String -deserializer (PT.Constant name meta type_ value) = "" -deserializer (PT.Alias name meta type_) = - (Text.unpack name |> Case.camel) - <> "Decoder :: " - <> "AesonT.Value -> AesonT.Parser (" - <> (Text.unpack name |> Case.pascal) - <> ")\n" - <> (Text.unpack name |> Case.camel) - <> "Decoder =\n " - <> deserializerMap type_ -deserializer (PT.Enum name meta members) = - (Text.unpack name |> Case.camel) - <> "Decoder :: " - <> "AesonT.Value -> AesonT.Parser (" - <> (Text.unpack name |> Case.pascal) - <> ")\n" - <> (Text.unpack name |> Case.camel) - <> "Decoder = Aeson.withText \"" - <> (Text.unpack name |> Case.pascal) - <> "\"\n (\\t -> Text.unpack t |> " - <> "\\a -> case a of\n " - <> ( List.map - (\case - PT.OtherValue txt -> - ( "\"" - <> (Case.quietSnake <| Text.unpack txt) - <> "\" -> return <| " - <> Text.unpack txt - ) - _ -> "" - ) - members - |> List.filter (/= "") - |> List.intersperse "\n " - |> List.concat - ) - <> "\n _ -> fail \"Invalid string for type " - <> (Text.unpack name |> Case.pascal) - <> "\"\n )" -deserializer (PT.Model name meta fields) = - (Text.unpack name |> Case.camel) - <> "Decoder :: " - <> "AesonT.Value -> AesonT.Parser (" - <> (Text.unpack name |> Case.pascal) - <> ")\n" - <> (Text.unpack name |> Case.camel) - <> "Decoder = Aeson.withObject \"" - <> (Text.unpack name |> Case.pascal) - <> "\" <| \\value -> " - <> (Text.unpack name |> Case.pascal) - <> "\n <$> " - <> ( List.map - (\field -> - "(value Aeson..: (fromString \"" - <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) - <> "\" :: Aeson.Key) >>= (" - <> (deserializerMap <| PT.fieldType field) - <> "))" - ) - fields - |> List.intersperse "\n <*> " - |> List.concat - ) - - -invTypeWriter :: PT.DataTypes -> String -invTypeWriter (PT.Constant name meta type_ value) = - docComments meta - <> (Text.unpack name |> Case.camel) - <> " :: " - <> typesMap type_ - <> "\n" - <> (Text.unpack name |> Case.camel) - <> " = " - <> valuesMap value -invTypeWriter (PT.Alias name meta type_) = - docComments meta - <> "type " - <> (Text.unpack name |> Case.pascal) - <> " = " - <> typesMap type_ - <> "\n\n\n" - <> serializer (PT.Alias name meta type_) - <> "\n\n\n" - <> deserializer (PT.Alias name meta type_) -invTypeWriter (PT.Enum name meta members) = - docComments meta - <> "data " - <> (Text.unpack name |> Case.pascal) - <> "\n = " - <> ( members - |> List.map valuesMap - |> List.intersperse "\n | " - |> List.concat - ) - <> "\n\n\n" - <> serializer (PT.Enum name meta members) - <> "\n\n\n" - <> deserializer (PT.Enum name meta members) -invTypeWriter (PT.Model name meta fields) = - docComments meta - <> "data " - <> (Text.unpack name |> Case.pascal) - <> " = " - <> (Text.unpack name |> Case.pascal) - <> "\n" - <> " { " - <> ( fields - |> List.map - (\f -> - (Text.unpack name |> Case.camel) - <> (Text.unpack (PT.fieldName f) |> Case.pascal) - <> " :: " - <> typesMap (PT.fieldType f) - ) - |> List.intersperse "\n , " - |> List.concat - ) - <> "\n }" - <> "\n\n\n" - <> serializer (PT.Model name meta fields) - <> "\n\n\n" - <> deserializer (PT.Model name meta fields) - - -typesWriter :: [PT.DataTypes] -> String -typesWriter types = - List.map invTypeWriter types - |> List.intersperse "\n\n\n" - |> List.concat - - -typesMap :: PT.Types -> String -typesMap = \case - PT.DTTStr -> "String" - PT.DTTInt -> "Int" - PT.DTTFloat -> "Float" - PT.DTTBool -> "Bool" - PT.DTTList a -> "[" <> typesMap a <> "]" - PT.DTTDict b -> "Map String " <> typesMap b - PT.DTTNullable a -> "Maybe " <> typesMap a - PT.DTTSet a -> "Set " <> typesMap a - PT.DTTTuple2 a b -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ")" - PT.DTTTuple3 a b c -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ")" - PT.DTTTuple4 a b c d -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ")" - PT.DTTTuple5 a b c d e -> - "(" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ", " - <> typesMap e - <> ")" - PT.DefinedDataTypes t -> Text.unpack t |> Case.pascal - -valuesMap :: PT.Values -> String -valuesMap = \case - PT.VStr str -> "\"" <> str <> "\"" - PT.VInt int -> show int - PT.VFloat flt -> show flt - PT.VBool bl -> show bl - PT.VList lst -> - "[" - <> ( List.map valuesMap lst - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VDict map -> - "Map.fromList [" - <> ( List.map - (\(k, v) -> - "(\"" - <> k - <> "\", " - <> valuesMap v - <> ")" - ) - (Map.toList map) - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VNullable nll -> case nll of - Just j -> "Just " <> valuesMap j - Nothing -> "Nothing" - PT.VSet set -> - "Set.fromList [" - <> ( List.map valuesMap (Set.toList set) - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VTuple2 (a, b) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ")" - PT.VTuple3 (a, b, c) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ")" - PT.VTuple4 (a, b, c, d) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ")" - PT.VTuple5 (a, b, c, d, e) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ", " - <> valuesMap e - <> ")" - PT.OtherValue t -> Text.unpack t |> Case.pascal - - -serializerMap :: PT.Types -> String -serializerMap = \case - PT.DTTStr -> "(Aeson.toJSON)" - PT.DTTInt -> "(Aeson.toJSON)" - PT.DTTFloat -> "(Aeson.toJSON)" - PT.DTTBool -> "(Aeson.toJSON)" - PT.DTTList a -> - "(\\l -> AesonT.listValue (" - <> serializerMap a - <> ") l) " - PT.DTTDict v -> "(\\d -> Aeson.toJSON d) " - PT.DTTNullable a -> "(Aeson.toJSON)" - PT.DTTSet a -> - "(\\a -> Aeson.object " - <> "[ (fromString \"set\" :: Aeson.Key) Aeson..= " - <> serializerMap a - <> "a])" - PT.DTTTuple2 a b -> - "(\\(a, b) -> Aeson.object " - <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " - <> serializerMap a - <> " a)" - <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " - <> serializerMap b - <> " b)" - <> "])" - PT.DTTTuple3 a b c -> - "(\\(a, b, c) -> Aeson.object " - <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " - <> serializerMap a - <> " a)" - <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " - <> serializerMap b - <> " b)" - <> ", ((fromString \"third\" :: Aeson.Key) Aeson..= " - <> serializerMap c - <> " c)" - <> "])" - PT.DTTTuple4 a b c d -> - "(\\(a, b, c, d) -> Aeson.object " - <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " - <> serializerMap a - <> " a)" - <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " - <> serializerMap b - <> " b)" - <> ", ((fromString \"third\" :: Aeson.Key) Aeson..= " - <> serializerMap c - <> " c)" - <> ", ((fromString \"fourth\" :: Aeson.Key) Aeson..= " - <> serializerMap d - <> " d)" - <> "])" - PT.DTTTuple5 a b c d e -> - "(\\(a, b, c, d, e) -> Aeson.object " - <> "[ ((fromString \"first\" :: Aeson.Key) Aeson..= " - <> serializerMap a - <> " a)" - <> ", ((fromString \"second\" :: Aeson.Key) Aeson..= " - <> serializerMap b - <> " b)" - <> ", ((fromString \"third\" :: Aeson.Key) Aeson..= " - <> serializerMap c - <> " c)" - <> ", ((fromString \"fourth\" :: Aeson.Key) Aeson..= " - <> serializerMap d - <> " d)" - <> ", ((fromString \"fifth\" :: Aeson.Key) Aeson..= " - <> serializerMap e - <> " e)" - <> "])" - PT.DefinedDataTypes txt -> - "(" - <> (Text.unpack txt |> Case.camel) - <> "Encoder) " - - -deserializerMap :: PT.Types -> String -deserializerMap = \case - PT.DTTStr -> "(Aeson.parseJSON)" - PT.DTTInt -> "(Aeson.parseJSON)" - PT.DTTFloat -> "(Aeson.parseJSON)" - PT.DTTBool -> "(Aeson.parseJSON)" - PT.DTTList a -> - "(AesonT.listParser (" - <> deserializerMap a - <> ")) " - PT.DTTDict v -> "(Aeson.parseJSON)" - PT.DTTNullable a -> "(Aeson.parseJSON)" - PT.DTTSet a -> - "(Aeson.withObject \"Set\" <| \\v ->" - <> "v Aeson..: (fromString \"set\" :: Aeson.Key) " - <> ">>= AesonT.listParser (" - <> deserializerMap a - <> ") " - <> ">>= return <. Set.fromList)" - PT.DTTTuple2 a b -> - "(Aeson.withObject \"Tuple2\" <| \\v -> (,) " - <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" - <> deserializerMap a - <> ")) " - <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" - <> deserializerMap b - <> ")))" - PT.DTTTuple3 a b c -> - "(Aeson.withObject \"Tuple3\" <| \\v -> (,,) " - <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" - <> deserializerMap a - <> ")) " - <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" - <> deserializerMap b - <> ")) " - <> "<*> (v Aeson..: (fromString \"third\" :: Aeson.Key) >>= (" - <> deserializerMap c - <> ")))" - PT.DTTTuple4 a b c d -> - "(Aeson.withObject \"Tuple4\" <| \\v -> (,,,) " - <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" - <> deserializerMap a - <> ")) " - <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" - <> deserializerMap b - <> ")) " - <> "<*> (v Aeson..: (fromString \"third\" :: Aeson.Key) >>= (" - <> deserializerMap c - <> ")) " - <> "<*> (v Aeson..: (fromString \"fourth\" :: Aeson.Key) >>= (" - <> deserializerMap d - <> ")))" - PT.DTTTuple5 a b c d e -> - "(Aeson.withObject \"Tuple5\" <| \\v -> (,,,,) " - <> "<$> (v Aeson..: (fromString \"first\" :: Aeson.Key) >>= (" - <> deserializerMap a - <> ")) " - <> "<*> (v Aeson..: (fromString \"second\" :: Aeson.Key) >>= (" - <> deserializerMap b - <> ")) " - <> "<*> (v Aeson..: (fromString \"third\" :: Aeson.Key) >>= (" - <> deserializerMap c - <> ")) " - <> "<*> (v Aeson..: (fromString \"fourth\" :: Aeson.Key) >>= (" - <> deserializerMap d - <> ")) " - <> "<*> (v Aeson..: (fromString \"fifth\" :: Aeson.Key) >>= (" - <> deserializerMap e - <> ")))" - PT.DefinedDataTypes txt -> - "(" - <> (Text.unpack txt |> Case.camel) - <> "Decoder) " diff --git a/app/Lang/Haskell/Writer.hs b/app/Lang/Haskell/Writer.hs deleted file mode 100644 index ef9fe28..0000000 --- a/app/Lang/Haskell/Writer.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Lang.Haskell.Writer where - - -import qualified Common.Utils as Com -import Data.Version (Version, makeVersion, - showVersion) -import Lang.Haskell.Config (LangConf (..)) -import qualified Lang.Haskell.Versions.GHCNineEightOne as GHC9_8_1 -import qualified Parsing.Types as PT - -haskellWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -haskellWriter langConf path typeData = let - haskV = langVersion langConf - in - if | langVersion langConf >= makeVersion [9, 8, 0] -> GHC9_8_1.writer langConf path typeData - | otherwise -> - print ("Unable to make out the correct writer for the specified Haskell version: " <> showVersion haskV) diff --git a/app/Lang/Python/Config.hs b/app/Lang/Python/Config.hs deleted file mode 100644 index c7b31b7..0000000 --- a/app/Lang/Python/Config.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Lang.Python.Config where - -import Data.Version (Version) -import Instances -import Parsing.Types (DataTypes) -import Text.Show.Functions - -data LangConf = - LangConf - { langWriter :: LangConf -> FilePath -> [(FilePath, [DataTypes])] -> IO () - , outputLocation :: FilePath - , langVersion :: Version - } - deriving (Show) diff --git a/app/Lang/Python/Toml.hs b/app/Lang/Python/Toml.hs deleted file mode 100644 index 7c0ecf0..0000000 --- a/app/Lang/Python/Toml.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Lang.Python.Toml where - - -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import Instances -import Lang.Python.Config (LangConf (..)) -import qualified Lang.Python.Versions.CPythonThreeTenTwelve as CPy3_10_12 -import Lang.Python.Writer (pythonWriter) -import Text.Show.Functions -import qualified Toml -import Toml ((.=)) - -confCodec :: Toml.TomlCodec LangConf -confCodec = LangConf - <$> pure pythonWriter - <*> Toml.string "output_location" .= outputLocation - <*> Extras.versionCodec "lang_version" .= langVersion diff --git a/app/Lang/Python/Versions/CPythonThreeTenTwelve.hs b/app/Lang/Python/Versions/CPythonThreeTenTwelve.hs deleted file mode 100644 index ddfedca..0000000 --- a/app/Lang/Python/Versions/CPythonThreeTenTwelve.hs +++ /dev/null @@ -1,607 +0,0 @@ -module Lang.Python.Versions.CPythonThreeTenTwelve where - -import qualified Antelude.File as File -import qualified Antelude.List as List -import qualified Antelude.Maybe as Maybe -import qualified Common.Utils as Com -import qualified Config.Extras as Extras -import qualified Control.Monad as Monad -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import Lang.Python.Config (LangConf (..)) -import qualified Parsing.Types as PT -import qualified System.Directory as Dir -import System.IO (FilePath) -import qualified Text.Casing as Case - - - -writer :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -writer pythonConf baseDir = let - path :: FilePath -> FilePath - path pth = (baseDir <> outputLocation pythonConf <> pythonDirPath pth) - in - Monad.mapM_ - (\(pth, lstType) -> - Dir.createDirectoryIfMissing - True - ( baseDir - <> outputLocation pythonConf - <> "/dtt/" - <> pythonDirPath pth - ) - >> File.writeFile - ( baseDir - <> outputLocation pythonConf - <> "/dtt/" - <> pythonFilePath pth - ) - ( header - <> staticImports - <> mapReferencedImports (pth, lstType) - <> "\n\n" - <> ( List.map - invTypeWriter - lstType - |> List.intersperse "\n\n\n" - |> List.concat - ) - ) - ) - -pythonDirPath :: FilePath -> FilePath -pythonDirPath = Com.typeFilePathToLangDirPath - Com.QuietSnakeCase - -pythonFilePath :: FilePath -> FilePath -pythonFilePath = Com.typeFilePathToLangFilePath - Com.QuietSnakeCase - ".py" - --- for the header of files, imports, etc -pythonCodePath :: FilePath -> String -pythonCodePath = Com.typeFilePathToLangCodePath - Com.QuietSnakeCase - '.' - - -header :: String -header = - "# This file was generated by DataTypeTool\n\n" - - -staticImports :: String -staticImports = - "from json import (JSONDecodeError, loads, dumps)\n" - <> "from enum import Enum\n" - <> "from dataclasses import dataclass\n" - <> "import typing\n" - -mapReferencedImports :: (FilePath, [PT.DataTypes]) -> String -mapReferencedImports (_, lstDtaTypes) = let - referencedImports :: [(FilePath, [PT.Types])] -> String - referencedImports metaStuff = - (List.map - (\(fp, lstTypes) -> - "from " - <> pythonCodePath fp - <> " import (" - <> ( lstTypes - |> List.map - (\case - PT.DefinedDataTypes txt -> - (typesMap <| PT.DefinedDataTypes txt) - <> ", " - <> (Text.unpack txt |> Case.quietSnake) - <> "_encoder, " - <> (deserializerMap <| PT.DefinedDataTypes txt) - _ -> "" - ) - |> List.filter (/= "") - |> List.intersperse ", " - |> List.concat - ) - <> ")" - ) - metaStuff - |> List.intersperse "\n" - |> List.concat - ) - <> "\n" - in - List.map - (\dtaType -> - case dtaType of - PT.Alias _ meta _ -> meta - PT.Enum _ meta _ -> meta - PT.Model _ meta _ -> meta - PT.Constant _ meta _ _ -> meta - |> \case - Just m -> - Maybe.map referencedImports (PT.metaRef m) - |> Maybe.withDefault "" - Nothing -> "" - ) - lstDtaTypes - |> List.filter (/= "") - |> List.intersperse "\n" - |> List.concat - - -docCommentsString :: Maybe PT.MetaField -> String -docCommentsString = \case - Just meta -> - case PT.metaDoc meta of - Just doc -> - "\n \"\"\"\n " - <> (List.lines (Text.unpack doc) - |> List.filter (/= "") - |> List.intersperse "\n " - |> List.concat - ) - <> "\n \"\"\"" - Nothing -> "" - Nothing -> "" - -docCommentsHash :: Maybe PT.MetaField -> String -docCommentsHash = \case - Just meta -> - case PT.metaDoc meta of - Just doc -> - "# " - <> (List.lines (Text.unpack doc) - |> List.filter (/= "") - |> List.intersperse "\n# " - |> List.concat - ) - <> "\n" - Nothing -> "" - Nothing -> "" - - --- serializer :: PT.DataTypes -> String --- serializer (PT.Constant name meta type_ value) = "" --- serializer (PT.Alias name meta type_) = --- "def " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_encoder(obj: " --- <> (Text.unpack name |> Case.pascal) --- <> ") -> str:" --- <> "\n return dumps(" --- <> serializerMap type_ --- <> "(obj))" --- serializer (PT.Enum name meta members) = --- "def " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_encoder(obj: " --- <> (Text.unpack name |> Case.pascal) --- <> ") -> str:" --- <> "\n match obj:" --- <> "\n " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( "case " --- <> (Text.unpack name |> Case.pascal) --- <> "." --- <> (Text.unpack txt |> Case.pascal) --- <> ":\n return dumps(\"" --- <> (Text.unpack txt |> Case.quietSnake) --- <> "\")" --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse "\n " --- |> List.concat --- ) --- serializer (PT.Model name meta fields) = --- "def " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_encoder(obj: " --- <> (Text.unpack name |> Case.pascal) --- <> ") -> str:" --- <> "\n return dumps({" --- <> "\n " --- <> ( List.map --- (\field -> --- "\"" --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "\": " --- <> (PT.fieldType field |> serializerMap) --- <> "(obj." --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> ")" --- ) --- fields --- |> List.intersperse ",\n " --- |> List.concat --- ) --- <> "\n })" - - --- deserializer :: PT.DataTypes -> String --- deserializer (PT.Constant name meta type_ value) = "" --- deserializer (PT.Alias name meta type_) = --- "def " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_decoder(json_val: str | bytes | bytearray) -> " --- <> (Text.unpack name |> Case.pascal) --- <> " | typing.NoReturn:" --- <> "\n return " --- <> deserializerMap type_ --- <> "(json_val) or None" --- deserializer (PT.Enum name meta members) = --- "def " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_decoder(json_val: typing.Union[str, bytes, bytearray]) -> " --- <> (Text.unpack name |> Case.pascal) --- <> " | typing.NoReturn:" --- <> "\n match loads(json_val):" --- <> "\n " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( "case \"" --- <> (Text.unpack txt |> Case.quietSnake) --- <> "\":\n return " --- <> (Text.unpack name |> Case.pascal) --- <> "." --- <> (Text.unpack txt |> Case.pascal) --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse "\n " --- |> List.concat --- ) --- <> "\n case err:" --- <> "\n raise JSONDecodeError(" --- <> "\n f\"Expected one of: " --- <> ( List.map --- (\case --- PT.OtherValue txt -> --- ( "\\\"" --- <> (Text.unpack txt |> Case.quietSnake) --- <> "\\\"" --- ) --- _ -> "" --- ) --- members --- |> List.filter (/= "") --- |> List.intersperse ", " --- |> List.concat --- ) --- <> ", Found: {err}\", json_val, None" --- <> "\n )" --- deserializer (PT.Model name meta fields) = --- "def " --- <> (Text.unpack name |> Case.quietSnake) --- <> "_decoder(json_val: typing.Union[str, bytes, bytearray, dict]) -> " --- <> (Text.unpack name |> Case.pascal) --- <> " | typing.NoReturn:" --- <> "\n json_dict = loads(json_val) if not isinstance(json_val, dict) else json_val\n " --- <> "return " --- <> (Text.unpack name |> Case.pascal) --- <> "(" --- <> ( List.map --- (\field -> --- "\n " --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> " = " --- <> (PT.fieldType field |> deserializerMap) --- <> "(json_dict.get(\"" --- <> (PT.fieldName field |> Text.unpack |> Case.quietSnake) --- <> "\"))" --- ) --- fields --- |> List.intersperse "," --- |> List.concat --- ) --- <> "\n )" - - -invTypeWriter :: PT.DataTypes -> String -invTypeWriter (PT.Constant name meta type_ value) = - docCommentsHash meta - <> (Text.unpack name |> Case.screamingSnake) - <> ": typing.Final[" - <> typesMap type_ - <> "] = " - <> valuesMap value -invTypeWriter (PT.Alias name meta type_) = - docCommentsHash meta - <> (Text.unpack name |> Case.pascal) - <> ": typing.TypeAlias = " - <> typesMap type_ - <> "\n\n\n" - -- <> serializer (PT.Alias name meta type_) - <> "\n\n\n" - -- <> deserializer (PT.Alias name meta type_) -invTypeWriter (PT.Enum name meta members) = - "class " - <> (Text.unpack name |> Case.pascal) - <> "(Enum):" - <> docCommentsString meta - <> "\n " - <> ( members - |> List.map (\m -> - (valuesMap m |> Case.pascal) - <> " = \"" - <> (valuesMap m |> Case.quietSnake) - <> "\"" - ) - |> List.intersperse "\n " - |> List.concat - ) - <> "\n\n\n" - -- <> serializer (PT.Enum name meta members) - <> "\n\n\n" - -- <> deserializer (PT.Enum name meta members) -invTypeWriter (PT.Model name meta fields) = - "@dataclass\nclass " - <> (Text.unpack name |> Case.pascal) - <> ":" - <> docCommentsString meta - <> "\n " - <> ( fields - |> List.map - (\f -> - (Text.unpack (PT.fieldName f) |> Case.quietSnake) - <> ": " - <> typesMap (PT.fieldType f) - ) - |> List.intersperse "\n " - |> List.concat - ) - <> "\n\n\n" - -- <> serializer (PT.Model name meta fields) - <> "\n\n\n" - -- <> deserializer (PT.Model name meta fields) - - -typesWriter :: [PT.DataTypes] -> String -typesWriter types = - List.map invTypeWriter types - |> List.intersperse "\n\n\n" - |> List.concat - - -typesMap :: PT.Types -> String -typesMap = \case - PT.DTTStr -> "str" - PT.DTTInt -> "int" - PT.DTTFloat -> "float" - PT.DTTBool -> "bool" - PT.DTTList a -> "list[" <> typesMap a <> "]" - PT.DTTDict b -> "dict[str, " <> typesMap b <> "]" - PT.DTTNullable a -> typesMap a <> " | None" - PT.DTTSet a -> "set[" <> typesMap a <> "]" - PT.DTTTuple2 a b -> - "tuple[" - <> typesMap a - <> ", " - <> typesMap b - <> "]" - PT.DTTTuple3 a b c -> - "tuple[" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> "]" - PT.DTTTuple4 a b c d -> - "tuple[" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> "]" - PT.DTTTuple5 a b c d e -> - "tuple[" - <> typesMap a - <> ", " - <> typesMap b - <> ", " - <> typesMap c - <> ", " - <> typesMap d - <> ", " - <> typesMap e - <> "]" - PT.DefinedDataTypes t -> Text.unpack t |> Case.pascal - -valuesMap :: PT.Values -> String -valuesMap = \case - PT.VStr str -> "\"" <> str <> "\"" - PT.VInt int -> show int - PT.VFloat flt -> show flt - PT.VBool bl -> show bl - PT.VList lst -> - "[" - <> ( List.map valuesMap lst - |> List.intersperse ", " - |> List.concat - ) - <> "]" - PT.VDict map -> - "{" - <> ( List.map - (\(k, v) -> - "#(" - <> k - <> ", " - <> valuesMap v - <> ")" - ) - (Map.toList map) - |> List.intersperse ", " - |> List.concat - ) - <> "}" - PT.VNullable nll -> (Maybe.mapWithDefault "None" valuesMap nll) - PT.VSet set -> - "{" - <> ( List.map valuesMap (Set.toList set) - |> List.intersperse ", " - |> List.concat - ) - <> "}" - PT.VTuple2 (a, b) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ")" - PT.VTuple3 (a, b, c) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ")" - PT.VTuple4 (a, b, c, d) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ")" - PT.VTuple5 (a, b, c, d, e) -> - "(" - <> valuesMap a - <> ", " - <> valuesMap b - <> ", " - <> valuesMap c - <> ", " - <> valuesMap d - <> ", " - <> valuesMap e - <> ")" - PT.OtherValue t -> Text.unpack t |> Case.pascal - - -serializerMap :: PT.Types -> String -serializerMap = \case - PT.DTTStr -> "str" - PT.DTTInt -> "int" - PT.DTTFloat -> "float" - PT.DTTBool -> "bool" - PT.DTTList a -> "(lambda l: [" <> serializerMap a <> "(lj) for lj in l])" - PT.DTTDict v -> - "(lambda d: { k: " - <> serializerMap v - <> "(v) for k, v in d})" - PT.DTTNullable a -> "(lambda n: "<> serializerMap a <> "(n) if n is not None else None)" - PT.DTTSet a -> - "(lambda s: { \"set\": [" - <> serializerMap a - <> "(a) for a in s]})" - PT.DTTTuple2 a b -> - "(lambda t: { \"first\": " - <> serializerMap a - <> "(t[0]), \"second\": " - <> serializerMap b - <> "(t[1])})" - PT.DTTTuple3 a b c -> - "(lambda t: { \"first\": " - <> serializerMap a - <> "(t[0]), \"second\": " - <> serializerMap b - <> "(t[1]), \"third\": " - <> serializerMap b - <> "(t[2])})" - PT.DTTTuple4 a b c d -> - "(lambda t: { \"first\": " - <> serializerMap a - <> "(t[0]), \"second\": " - <> serializerMap b - <> "(t[1]), \"third\": " - <> serializerMap b - <> "(t[2]), \"fourth\": " - <> serializerMap b - <> "(t[3])})" - PT.DTTTuple5 a b c d e -> - "(lambda t: { \"first\": " - <> serializerMap a - <> "(t[0]), \"second\": " - <> serializerMap b - <> "(t[1]), \"third\": " - <> serializerMap b - <> "(t[2]), \"fourth\": " - <> serializerMap b - <> "(t[3]), \"fifth\": " - <> serializerMap b - <> "(t[4])})" - PT.DefinedDataTypes txt -> "(lambda dt: loads(" <> (Text.unpack txt |> Case.quietSnake) <> "_encoder(dt)))" - - -deserializerMap :: PT.Types -> String -deserializerMap = \case - PT.DTTStr -> "str" - PT.DTTInt -> "int" - PT.DTTFloat -> "float" - PT.DTTBool -> "bool" - PT.DTTList a -> "(lambda list_json: [" <> deserializerMap a <> "(l) for l in list_json])" - PT.DTTDict v -> - "(lambda dict_json: {k: " - <> deserializerMap v - <> "(v) for k, v in dict_json})" - PT.DTTNullable a -> "(lambda n: "<> serializerMap a <> "(n) if n is not None else None)" - PT.DTTSet a -> - "(lambda set_json: set([" - <> deserializerMap a - <> "(s) for s in set_json.get(\"set\")]))" - PT.DTTTuple2 a b -> - "(lambda tup_json: (" - <> deserializerMap a - <> "(tup_json.get(\"first\")), " - <> deserializerMap b - <> "(tup_json.get(\"second\"))" - <> "))" - PT.DTTTuple3 a b c -> - "(lambda tup_json: (" - <> deserializerMap a - <> "(tup_json.get(\"first\")), " - <> deserializerMap b - <> "(tup_json.get(\"second\")), " - <> deserializerMap c - <> "(tup_json.get(\"third\"))" - <> "))" - PT.DTTTuple4 a b c d -> - "(lambda tup_json: (" - <> deserializerMap a - <> "(tup_json.get(\"first\")), " - <> deserializerMap b - <> "(tup_json.get(\"second\")), " - <> deserializerMap c - <> "(tup_json.get(\"third\")), " - <> deserializerMap d - <> "(tup_json.get(\"fourth\"))" - <> "))" - PT.DTTTuple5 a b c d e -> - "(lambda tup_json: (" - <> deserializerMap a - <> "(tup_json.get(\"first\")), " - <> deserializerMap b - <> "(tup_json.get(\"second\")), " - <> deserializerMap c - <> "(tup_json.get(\"third\")), " - <> deserializerMap d - <> "(tup_json.get(\"fourth\")), " - <> deserializerMap e - <> "(tup_json.get(\"fifth\"))" - <> "))" - PT.DefinedDataTypes txt -> Text.unpack txt |> Case.quietSnake |> (<> "_decoder") diff --git a/app/Lang/Python/Writer.hs b/app/Lang/Python/Writer.hs deleted file mode 100644 index 29ef2a8..0000000 --- a/app/Lang/Python/Writer.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Lang.Python.Writer where - - -import qualified Common.Utils as Com -import Data.Version (Version, - makeVersion, - showVersion) -import Lang.Python.Config (LangConf (..)) -import qualified Lang.Python.Versions.CPythonThreeTenTwelve as CPy3_10_12 -import qualified Parsing.Types as PT - - -pythonWriter :: LangConf -> FilePath -> [(FilePath, [PT.DataTypes])] -> IO () -pythonWriter langConf path typeData = let - pyV = langVersion langConf - in - if | (Com.betweenOrEqualLower pyV - (makeVersion [3, 10, 0]) - (makeVersion [3, 11, 0])) - -> CPy3_10_12.writer langConf path typeData - | otherwise -> - print ("Unable to make out the correct writer for the specified Python version: " <> showVersion pyV) diff --git a/app/Main.hs b/app/Main.hs index f46b72a..375bae4 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,108 +1,166 @@ module Main where -import qualified Antelude.List as List -import qualified Antelude.List.NonEmpty as NE -import qualified Antelude.Maybe as Maybe -import qualified Antelude.Monad as Monad -import Antelude.String (fromString) -import qualified Cli -import qualified Common.Utils as Com -import qualified Config.Config as Config -import qualified Control.Monad as CtrlMonad -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import Instances -import qualified Options.Applicative as Opts -import qualified Parsing.Parser as Parser -import qualified Parsing.Types as PT -import qualified System.Directory as Dir -import System.FilePath (pathSeparator) -import qualified Text.Megaparsec as MP -import Text.Show.Functions +import qualified Antelude.File as File +import qualified Antelude.IO as IO +import qualified Antelude.List as List +import qualified Antelude.List.NonEmpty as NE +import qualified Antelude.Maybe as Maybe +import qualified Antelude.Monad as Monad +import qualified Antelude.String as String + +import qualified Control.Monad as CtrlMonad + +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text + +import DataTypeTool.Cli ( Flags, tomlPath ) +import qualified DataTypeTool.Cli as Cli +import qualified DataTypeTool.Common.Utils as Com +import qualified DataTypeTool.Config.Config as Config +import DataTypeTool.Lang.DTT.Default ( defaultTypes, newToml ) +import qualified DataTypeTool.Parsing.Parser as Parser +import qualified DataTypeTool.Parsing.Types as PT + +import qualified Options.Applicative as Opts + +import qualified System.Directory as Dir +import qualified System.Exit as Exit ( die ) +import System.FilePath ( pathSeparator ) + +import qualified Text.Megaparsec as MP + import qualified Toml main :: IO () main = do cwd <- Dir.getCurrentDirectory Opts.execParser (Cli.opts cwd) >>= run - where - run :: Cli.Flags -> IO () - run flags = do - Toml.decodeFileEither Config.datatypetoolCodec <| Cli.tomlPath flags + where + run :: Flags -> IO () + run flags = + do + -- Do we have a Toml? If not, ask to make one. + Dir.doesFileExist flags.tomlPath + >>= \case + True -> + return () + False -> + askToGenerateToml flags.tomlPath + -- Decode the toml + >> Toml.decodeFileEither Config.datatypetoolCodec flags.tomlPath >>= \case - Left _ -> print "Error occurred!" - - Right config -> let - tomlDir :: FilePath -> FilePath - tomlDir tomlAbsFp = List.reverse tomlAbsFp - |> List.dropWhile (/= pathSeparator) - |> List.drop 1 - |> List.reverse - - mkTypeDir :: FilePath -> IO FilePath - mkTypeDir tomlAbsFp = Dir.canonicalizePath - ( tomlDir tomlAbsFp - <> [pathSeparator] - <> Config.sources config - ) - - absTomlDir absPath = absPath - |> List.reverse - |> List.dropWhile (/= pathSeparator) - |> List.reverse - in do - absTomlPath <- Dir.canonicalizePath <| Cli.tomlPath flags - absTypeDir <- mkTypeDir absTomlPath - - -- Filter for valid directories - Dir.doesDirectoryExist absTypeDir - >>= \case - True -> do - -- runParsersTest absTypeDir config - runParsers absTypeDir config - >>= Monad.mapM_ - (\(fp, res) -> case res of - Left l -> print ("Some error occurred: " <> show l) - Right r -> - Monad.mapM_ - (\trgt -> - Config.runLangWriter - trgt - (absTomlDir absTomlPath) - [(fp, r)] - ) - (NE.toList <| Config.targets config) - ) - return () - False -> return () - - runParsers :: - FilePath -> - Config.Config -> - IO [( FilePath - , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile - )] - runParsers typeFileDirectory config = - Com.recurseDirectory typeFileDirectory - >>= return <. List.map - ( \(pth, str) -> - (List.stripPrefix typeFileDirectory pth - |> Maybe.withDefault pth - , (case List.last str of - Just '\n' -> str - _ -> str <> "\n" - ) |> MP.parse (Parser.parser (Config.spacing config)) pth - ) + Left tomlErrs -> + Toml.prettyTomlDecodeErrors tomlErrs + |> String.unText + |> Exit.die + Right config -> + runWithConfig flags.tomlPath config + + runWithConfig :: FilePath -> Config.Config -> IO () + runWithConfig tomlPath config = + let tomlDir :: FilePath -> FilePath + tomlDir = + List.reverse + .> List.dropWhile (/= pathSeparator) + .> List.drop 1 + .> List.reverse + + mkTypeDir :: FilePath -> IO FilePath + mkTypeDir tomlAbsFp = + Dir.canonicalizePath + ( tomlDir tomlAbsFp + <> [pathSeparator] + <> Config.sources config ) - runParsersTest :: - FilePath -> - Config.Config -> - IO () - runParsersTest typeFileDirectory config = do - Com.recurseDirectory typeFileDirectory - >>= Monad.mapM_ - ( \(pth, str) -> - MP.parseTest (Parser.parser (Config.spacing config)) str + absTomlDir :: FilePath -> FilePath + absTomlDir = + List.reverse + .> List.dropWhile (/= pathSeparator) + .> List.reverse + + runWriter + :: FilePath + -> Pair + FilePath + PT.DataTypeFile + -> Config.LangConfiguration + -> IO () + runWriter absTomlPath (fp, res) target = + Config.runLangWriter + target + (absTomlDir absTomlPath) + [(fp, res)] + + handleParsingResults + :: FilePath + -> Pair + FilePath + (Either + (MP.ParseErrorBundle String Void) + PT.DataTypeFile ) - return () + -> IO () + handleParsingResults absTomlPath (fp, res) = + case res of + Left l -> + IO.putStrLn ("Some error occurred: " <> show l) + Right r -> + -- Generate types from the results + Monad.mapM_ + (runWriter absTomlPath (fp, r)) + (NE.toList config.targets) + in do + absTomlPath <- Dir.canonicalizePath tomlPath + absTypeDir <- mkTypeDir absTomlPath + + -- Filter for valid directories + Dir.doesDirectoryExist absTypeDir + -- Do we have the type directory from the Toml? + -- If not, ask to make it. + >>= \case + True -> + return () + False -> + askToGenerateTypeExample + absTypeDir + config + -- Parse the type files + >> Parser.runParsers absTypeDir config + >>= Monad.mapM_ (handleParsingResults absTomlPath) + + askToGenerateToml :: FilePath -> IO () + askToGenerateToml tomlPath = do + IO.putStrLn "No valid datatypetool.toml found in current directory." + IO.putStrLn "Would you like to generate one? (y/n)" + answer <- IO.getLine + if + | List.contains answer Cli.yeses -> + IO.putStrLn "Creating default toml." + >> File.writeFile tomlPath newToml + | List.contains answer Cli.nos -> + Exit.die "No toml found. Ending." + | otherwise -> + Exit.die ("Unknown option: " <> answer) + + askToGenerateTypeExample + :: FilePath + -> Config.Config + -> IO () + askToGenerateTypeExample absTypeDir config = do + IO.putStrLn "Directory where types are said to exist does not exist." + IO.putStrLn "Would you like to generate this directory with an example? (y/n)" + answer <- IO.getLine + if + | List.contains answer Cli.yeses -> + IO.putStrLn "Creating default types." + >> Dir.createDirectoryIfMissing + True + absTypeDir + >> File.writeFile + (absTypeDir <> "/Example.type") + (defaultTypes config.spacing) + | List.contains answer Cli.nos -> + Exit.die "No types found. Ending." + | otherwise -> + Exit.die ("Unknown option: " <> answer) diff --git a/app/Parsing/Parser.hs b/app/Parsing/Parser.hs deleted file mode 100644 index 4acf127..0000000 --- a/app/Parsing/Parser.hs +++ /dev/null @@ -1,721 +0,0 @@ -module Parsing.Parser where - - -import qualified Antelude.List as List -import qualified Antelude.Maybe as Maybe -import Antelude.Monad (fail, mapM, replicateM_, void) -import Antelude.String (fromString) -import qualified Common.Utils as Com -import qualified Config.Config as Config -import qualified Data.List as UnsafeList (head) -import Data.Map.Strict ((!)) -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import qualified Parsing.Types as PT -import qualified System.Directory as Dir -import qualified Text.Megaparsec as MP -import qualified Text.Megaparsec.Char as MPC -import qualified Text.Megaparsec.Char.Lexer as MPCL -import qualified Text.Megaparsec.Debug as MPD - - -type Parser = MP.Parsec Void String - -type Spacer = Parser () - - -parser :: Config.Spacing -> Parser PT.DataTypeFile -parser spacing = let - spacer :: Parser () - spacer = case spacing of - Config.Tabs -> tab - Config.Spaces2 -> space2 - Config.Spaces3 -> space3 - Config.Spaces4 -> space4 - - spacePos :: Int - spacePos = case spacing of - Config.Tabs -> 4 - Config.Spaces2 -> 2 - Config.Spaces3 -> 3 - Config.Spaces4 -> 4 - - - dataTypeParser :: Parser PT.DataTypes - dataTypeParser = - MPCL.nonIndented spaceAny - ( MP.choice - [ MPCL.indentBlock spaceAny <| do - voidString "alias " - name <- nameParser - MPC.space - colon - return - (MPCL.IndentMany - (Just (MP.mkPos <| 1 + spacePos)) - (aliasMapper name <. Map.toList <. Map.fromList) - aliasParser - ) - , MPCL.indentBlock spaceAny <| do - voidString "enum " - name <- nameParser - MPC.space - colon - return - (MPCL.IndentMany - (Just (MP.mkPos <| 1 + spacePos)) - (enumMapper name <. Map.toList <. Map.fromList) - enumParser - ) - , MPCL.indentBlock spaceAny <| do - voidString "model " - name <- nameParser - MPC.space - colon - return - (MPCL.IndentMany - (Just (MP.mkPos <| 1 + spacePos)) - (modelMapper name <. Map.toList <. Map.fromList) - modelParser - ) - , MPCL.indentBlock spaceAny <| do - voidString "constant " - name <- nameParser - MPC.space - colon - return - (MPCL.IndentMany - (Just (MP.mkPos <| 1 + spacePos)) - (constantMapper name <. Map.toList <. Map.fromList) - constantParser - ) - ] - ) - - aliasMapper :: Text -> [(String, PT.AliasParams)] -> Parser PT.DataTypes - aliasMapper name map = let - meta :: Maybe PT.MetaField - meta = (List.lookup "meta" map - |> \case - Just (PT.AliasMeta m) -> m - _ -> Nothing - ) - - type_ :: Maybe PT.Types - type_ = (List.lookup "type" map - |> \case - Just (PT.AliasType t) -> Just t - _ -> Nothing - ) - in - case type_ of - Just t -> return <| PT.Alias name meta t - _ -> fail "Insufficient parameters passed to alias type" - - aliasParser :: Parser (String, PT.AliasParams) - aliasParser = MPCL.lexeme spacer - <| MP.choice - [ MPCL.indentBlock spaceAny <| do - voidString "meta:" - indentWrapper - "meta" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.AliasMeta <. metaMapper <. Map.toList <. Map.fromList) - metaParser - , MPCL.indentBlock spaceAny <| do - voidString "type:" - indentWrapper - "type" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.AliasType <. UnsafeList.head) - typeParser - ] - - enumMapper :: Text -> [(String, PT.EnumParams)] -> Parser PT.DataTypes - enumMapper name map = let - meta :: Maybe PT.MetaField - meta = (List.lookup "meta" map - |> \case - Just (PT.EnumMeta m) -> m - _ -> Nothing - ) - - members :: Maybe [PT.Values] - members = (List.lookup "members" map - |> \case - Just (PT.EnumMembers e) -> Just e - _ -> Nothing - ) - in - case members of - Just m -> return <| PT.Enum name meta m - _ -> fail "Insufficient parameters passed to enum type" - - enumParser :: Parser (String, PT.EnumParams) - enumParser = MPCL.lexeme spacer - <| MP.choice - [ MPCL.indentBlock spaceAny <| do - voidString "meta:" - indentWrapper - "meta" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.EnumMeta <. metaMapper <. Map.toList <. Map.fromList) - metaParser - , MPCL.indentBlock spaceAny <| do - voidString "members:" - indentWrapper - "members" - (MP.mkPos <| 1 + (spacePos * 2)) - PT.EnumMembers - valueParser - ] - - modelMapper :: Text -> [(String, PT.ModelParams)] -> Parser PT.DataTypes - modelMapper name map = let - meta :: Maybe PT.MetaField - meta = (List.lookup "meta" map - |> \case - Just (PT.ModelMeta m) -> m - _ -> Nothing - ) - - fields :: Maybe [PT.ModelField] - fields = (List.lookup "fields" map - |> \case - Just (PT.ModelFields f) -> Just f - _ -> Nothing - ) - in - case fields of - Just f -> return <| PT.Model name meta f - _ -> fail "Insufficient parameters passed to model type" - - modelParser :: Parser (String, PT.ModelParams) - modelParser = MPCL.lexeme spacer - <| MP.choice - [ MPCL.indentBlock spaceAny <| do - voidString "meta:" - indentWrapper - "meta" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.ModelMeta <. metaMapper <. Map.toList <. Map.fromList) - metaParser - , MPCL.indentBlock spaceAny <| do - voidString "fields:" - indentWrapper - "fields" - (MP.mkPos <| 1 + (spacePos * 2)) - PT.ModelFields - modelFieldsParser - ] - - modelFieldsParser :: Parser PT.ModelField - modelFieldsParser = MPCL.lexeme spacer - <| MPCL.indentBlock spaceAny <| do - voidString "field " - name <- nameParser - MPC.space - colon - return - (MPCL.IndentMany - (Just <| (MP.mkPos <| 1 + (spacePos * 3))) - (return <. fieldMapper name) - fieldParser - ) - - fieldMapper :: Text -> [PT.Types] -> PT.ModelField - fieldMapper name types = - PT.ModelField name (UnsafeList.head types) - - fieldParser :: Parser PT.Types - fieldParser = MPCL.lexeme spacer - <| MPCL.indentBlock spaceAny <| do - voidString "type:" - return - (MPCL.IndentMany - (Just <| (MP.mkPos <| 1 + (spacePos * 4))) - (return <. UnsafeList.head) - typeParser - ) - - constantMapper :: Text -> [(String, PT.ConstantParams)] -> Parser PT.DataTypes - constantMapper name map = let - meta :: Maybe PT.MetaField - meta = (List.lookup "meta" map - |> \case - Just (PT.ConstantMeta m) -> m - _ -> Nothing - ) - - type_ :: Maybe PT.Types - type_ = (List.lookup "type" map - |> \case - Just (PT.ConstantType t) -> Just t - _ -> Nothing - ) - - value :: Maybe PT.Values - value = (List.lookup "value" map - |> \case - Just (PT.ConstantValue v) -> Just v - _ -> Nothing - ) - in - case (type_, value) of - (Just t, Just v) -> return <| PT.Constant name meta t v - _ -> fail "Insufficient parameters passed to constant type" - - constantParser :: Parser (String, PT.ConstantParams) - constantParser = MPCL.lexeme spacer - <| MP.choice - [ MPCL.indentBlock spaceAny <| do - voidString "meta:" - indentWrapper - "meta" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.ConstantMeta <. metaMapper <. Map.toList <. Map.fromList) - metaParser - , MPCL.indentBlock spaceAny <| do - voidString "type:" - indentWrapper - "type" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.ConstantType <. UnsafeList.head) - typeParser - , MPCL.indentBlock spaceAny <| do - voidString "value:" - indentWrapper - "value" - (MP.mkPos <| 1 + (spacePos * 2)) - (PT.ConstantValue <. UnsafeList.head) - valueParser - ] - - metaMapper :: [(String, PT.MetaParams)] -> Maybe PT.MetaField - metaMapper map = let - doc :: Maybe Text - doc = (List.lookup "doc" map - |> \case - Just (PT.MetaDoc d) -> d - _ -> Nothing - ) - - ref :: Maybe [(FilePath, [PT.Types])] - ref = (List.lookup "ref" map - |> \case - Just (PT.MetaRef r) -> r - _ -> Nothing - ) - - lang :: Maybe [Text] - lang = (List.lookup "lang" map - |> \case - Just (PT.MetaLang l) -> l - _ -> Nothing - ) - in - case (doc, ref, lang) of - (Nothing, Nothing, Nothing) -> fail "No parameters passed to meta field, but a meta field was opened." - _ -> return <| PT.MetaField doc ref lang - - metaParser :: Parser (String, PT.MetaParams) - metaParser = MPCL.lexeme spacer - <| MP.choice - [ MPCL.indentBlock spaceAny <| do - voidString "doc:" - indentWrapper - "doc" - (MP.mkPos <| 1 + (spacePos * 3)) - (PT.MetaDoc <. docMapper) - docParser - , MPCL.indentBlock spaceAny <| do - voidString "ref:" - indentWrapper - "ref" - (MP.mkPos <| 1 + (spacePos * 3)) - (PT.MetaRef <. Just) - refParser - , MPCL.indentBlock spaceAny <| do - voidString "lang:" - indentWrapper - "lang" - (MP.mkPos <| 1 + (spacePos * 3)) - (PT.MetaLang <. Just) - langParser - ] - - docMapper :: [Text] -> Maybe Text - docMapper docLines = Just <| List.foldl (\a b -> a <> Text.pack "\n" <> b ) (Text.pack "") docLines - - docParser :: Parser Text - docParser = MPCL.lexeme spacer - <| MP.manyTill MPCL.charLiteral eol >>= return <. Text.pack - - refParser :: Parser (FilePath, [PT.Types]) - refParser = MPCL.lexeme spacer - <| do - path <- pathParser - colon - types_ <- MP.sepBy1 definedTypeParser colon - return - <| ( path - , types_ - ) - - langParser :: Parser Text - langParser = langLangParser - - langLangParser :: Parser Text - langLangParser = MPCL.lexeme spacer <| do - lang <- MP.choice - [ MPC.string "haskell" - , MPC.string "python" - , MPC.string "elm" - , MPC.string "gleam" - ] - >>= return <. Text.pack - eol - return lang - - typeParser :: Parser PT.Types - typeParser = let - type_ :: Parser PT.Types - type_ = MP.choice - [ PT.DTTStr <$ MPC.string "Str" - , PT.DTTInt <$ MPC.string "Int" - , PT.DTTFloat <$ MPC.string "Float" - , PT.DTTBool <$ MPC.string "Bool" - , do - voidString "Dict " - PT.DTTDict <$> typeParser - , do - voidString "List " - PT.DTTList <$> typeParser - , do - voidString "Nullable " - PT.DTTNullable <$> typeParser - , do - voidString "Set " - PT.DTTSet <$> typeParser - , do - voidString "Tuple2" - PT.DTTTuple2 - <$> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - , do - voidString "Tuple3" - PT.DTTTuple3 - <$> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - , do - voidString "Tuple4" - PT.DTTTuple4 - <$> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - , do - voidString "Tuple5" - PT.DTTTuple5 - <$> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - <*> do - MPC.char ' ' - typeParser - , definedTypeParser - ] - in ( do - MPC.char '(' - spaceAny - t <- type_ - spaceAny - MPC.char ')' - return t - ) - <|> type_ - - valueParser :: Parser PT.Values - valueParser = let - val = MP.choice - [ MPC.char '"' - >> MP.manyTill MPCL.charLiteral (MPC.char '"') - >>= return <. PT.VStr - , (MPCL.signed spaceAny - <| MPCL.lexeme spacer - <| MPCL.decimal - ) >>= return <. PT.VInt - , (MPCL.signed spaceAny - <| MPCL.lexeme spacer - <| MPCL.float - ) >>= return <. PT.VFloat - , MP.choice - [ PT.VBool True <$ MPC.string "True" - , PT.VBool False <$ MPC.string "False" - ] - , MPCL.lexeme spaceAny <| voidString "Dict" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "[") - (MPCL.symbol spaceAny "]") - ( MP.sepBy - (MP.between - (MPCL.symbol spaceAny "{") - (MPCL.symbol spaceAny "}") - ( do - k <- MPC.char '"' - >> MP.manyTill MPCL.charLiteral (MPC.char '"') - voidString ", " - v <- valueParser - return (k, v) - ) - ) - (voidString ", ") - ) - >>= return <. PT.VDict <. Map.fromList - , MPCL.lexeme spaceAny <| voidString "List" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "[") - (MPCL.symbol spaceAny "]") - (MP.sepBy valueParser (MPC.char ',')) - >>= return <. PT.VList - , MP.choice - [ do - voidString "NotNull " - jVal <- valueParser - return <| PT.VNullable <| Just jVal - , PT.VNullable Nothing <$ voidString "Null" - ] - , MPCL.lexeme spaceAny <| voidString "Set" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "[") - (MPCL.symbol spaceAny "]") - (MP.sepBy valueParser (MPC.char ',') - >>= return <. PT.VSet <. Set.fromList - ) - , MPCL.lexeme spaceAny <| voidString "Tuple2" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "{") - (MPCL.symbol spaceAny "}") - ( do - a <- valueParser - b <- valueParser - return (a, b) - ) - >>= return <. PT.VTuple2 - , MPCL.lexeme spaceAny <| voidString "Tuple3" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "{") - (MPCL.symbol spaceAny "}") - ( do - a <- valueParser - b <- valueParser - c <- valueParser - return (a, b, c) - ) - >>= return <. PT.VTuple3 - , MPCL.lexeme spaceAny <| voidString "Tuple4" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "{") - (MPCL.symbol spaceAny "}") - ( do - a <- valueParser - b <- valueParser - c <- valueParser - d <- valueParser - return (a, b, c, d) - ) - >>= return <. PT.VTuple4 - , MPCL.lexeme spaceAny <| voidString "Tuple5" - >> spaceAny - >> MP.between - (MPCL.symbol spaceAny "{") - (MPCL.symbol spaceAny "}") - ( do - a <- valueParser - b <- valueParser - c <- valueParser - d <- valueParser - e <- valueParser - return (a, b, c, d, e) - ) - >>= return <. PT.VTuple5 - , MPCL.lexeme spaceAny <| nameParser - >>= return <. PT.OtherValue - ] - in - MP.between - (MPCL.symbol spaceAny "(") - (MPCL.symbol spaceAny ")") - val - <|> val - - nameParser :: Parser Text - nameParser = MPCL.lexeme spacer <| do - first <- MPC.upperChar - rest <- MP.many - (MP.choice - [ MPC.alphaNumChar - , MPC.char '_' - ] - ) - return <| Text.pack (first : rest) - - -- A specific packed version of nameParser - definedTypeParser :: Parser PT.Types -- Specifically (DefinedDataTypes Text) - definedTypeParser = MPCL.lexeme spacer <| do - first <- MPC.upperChar - rest <- MP.many - (MP.choice - [ MPC.alphaNumChar - , MPC.char '_' - ] - ) - return <| PT.DefinedDataTypes <| Text.pack (first : rest) - - pathParser :: Parser FilePath - pathParser = MPCL.lexeme spacer <| MP.many - (MP.choice - [ MPC.alphaNumChar - , MPC.char '_' - , MPC.char '-' - , MPC.char '/' - , MPC.char '\\' - ] - ) - - pathAsTextParser :: Parser Text - pathAsTextParser = MPCL.lexeme spacer <| MP.many - (MP.choice - [ MPC.alphaNumChar - , MPC.char '_' - , MPC.char '-' - , MPC.char '/' - , MPC.char '\\' - ] - ) - >>= return <. Text.pack - - anyNameParser :: Parser Text - anyNameParser = MPCL.lexeme spacer <| do - MP.many - (MP.choice - [ MPC.alphaNumChar - , MPC.char '_' - ] - ) - >>= return <. Text.pack - - indentWrapper :: - String -> - MP.Pos -> - ([a] -> c) -> - Parser a -> - Parser - (MPCL.IndentOpt - Parser - (String, c) - a - ) - indentWrapper field pos wrapperMapper parser = - return - (MPCL.IndentMany - (Just pos) - (\a -> - return (field, wrapperMapper a) - ) - parser - ) - in - MP.someTill - dataTypeParser - MP.eof - - -lineComment :: Parser () -lineComment = - MPCL.skipLineComment "#" - - -space2 :: Parser () -space2 = MPCL.space - (replicateM_ 2 (MPC.char ' ')) - lineComment - MP.empty - - -space3 :: Parser () -space3 = MPCL.space - (replicateM_ 3 (MPC.char ' ')) - lineComment - MP.empty - - -space4 :: Parser () -space4 = MPCL.space - (replicateM_ 4 (MPC.char ' ')) - lineComment - MP.empty - - -tab :: Parser () -tab = MPCL.space - (void <| MPC.char '\t') - lineComment - MP.empty - - -spaceAny :: Parser () -spaceAny = MPCL.space - MPC.space1 - lineComment - MP.empty - - -eol :: Parser () -eol = void MPC.eol - - -colon :: Parser () -colon = void (MPC.char ':') - - -voidString :: String -> Parser () -voidString str = void (MPC.string str) - -nullParser :: Parser () -nullParser = return () diff --git a/app/Parsing/Types.hs b/app/Parsing/Types.hs deleted file mode 100644 index d12491e..0000000 --- a/app/Parsing/Types.hs +++ /dev/null @@ -1,129 +0,0 @@ -module Parsing.Types where - -import qualified Antelude.List as List -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import Text.Show.Functions - -type DataTypeFile = [DataTypes] - -data Types - -- Encodable - = DTTStr - | DTTInt - | DTTFloat - | DTTBool - | DTTList Types - | DTTDict Types - -- Nullability - | DTTNullable Types - -- Not _Normally_ Encodable - | DTTSet Types - | DTTTuple2 Types Types - | DTTTuple3 Types Types Types - | DTTTuple4 Types Types Types Types - | DTTTuple5 Types Types Types Types Types - -- .type-File Defined - | DefinedDataTypes Text - deriving (Show) - - -data Values - = VStr String - | VInt Integer - | VFloat Float - | VBool Bool - | VList [Values] - | VDict (Map String Values) - | VNullable (Maybe Values) - | VSet (Set Values) - | VTuple2 (Values, Values) - | VTuple3 (Values, Values, Values) - | VTuple4 (Values, Values, Values, Values) - | VTuple5 (Values, Values, Values, Values, Values) - | OtherValue Text - deriving (Show, Eq, Ord) - - - -data DataTypes - = Alias - { aliasName :: Text - , aliasMeta :: Maybe MetaField - , aliasType :: Types - } - | Enum - { enumName :: Text - , enumMeta :: Maybe MetaField - , enumMembers :: [Values] - } - | Model - { modelName :: Text - , modelMeta :: Maybe MetaField - , modelFields :: [ModelField] - } - | Constant - { constantName :: Text - , constantMeta :: Maybe MetaField - , constantType :: Types - , constantValue :: Values - } - deriving (Show) - - -data AliasParams - = AliasMeta (Maybe MetaField) - | AliasType Types - deriving (Show) - - -data EnumParams - = EnumName Text - | EnumMeta (Maybe MetaField) - | EnumMembers [Values] - deriving (Show) - - -data ModelParams - = ModelName Text - | ModelMeta (Maybe MetaField) - | ModelFields [ModelField] - deriving (Show) - - -data ConstantParams - = ConstantName Text - | ConstantMeta (Maybe MetaField) - | ConstantType Types - | ConstantValue Values - deriving (Show) - - -data MetaField = - MetaField - { metaDoc :: Maybe Text - , metaRef :: Maybe [(FilePath, [Types])] - , metaLang :: Maybe [Text] - } - deriving (Show) - - -data MetaParams - = MetaDoc (Maybe Text) - | MetaRef (Maybe [(FilePath, [Types])]) - | MetaLang (Maybe [Text]) - deriving (Show) - - -data ModelField = - ModelField - { fieldName :: Text - , fieldType :: Types - } - deriving (Show) - - -data ModelFieldParams - = FieldName Text - | FieldType Types - deriving (Show) diff --git a/app/Prelude.hs b/app/Prelude.hs index 2fd1817..ffe247f 100644 --- a/app/Prelude.hs +++ b/app/Prelude.hs @@ -5,7 +5,25 @@ module Prelude import Antelude +import Data.Eq ( Eq (..) ) +import Data.Ord ( Ord (..) ) + +import Text.Show.Functions + infixr 5 ++ (++) :: List a -> List a -> List a (++) = (<>) + +instance Eq (a -> b) where + (==) _ _ = True + (/=) _ _ = False + +instance Ord (a -> b) where + compare _ _ = EQ + (<) _ _ = False + (<=) _ _ = True + (>) _ _ = False + (>=) _ _ = True + min _ f2 = f2 + max f1 _ = f1 diff --git a/datatypetool.cabal b/datatypetool.cabal index 85f2297..d62d4f3 100644 --- a/datatypetool.cabal +++ b/datatypetool.cabal @@ -16,44 +16,49 @@ maintainer: dneavesdev@pm.me executable datatypetool main-is: Main.hs hs-source-dirs: app + -- testProject/app default-language: GHC2021 - default-extensions: LambdaCase - , MultiWayIf - , TupleSections - , OverloadedRecordDot + default-extensions: + LambdaCase + MultiWayIf + OverloadedRecordDot + TupleSections + -- ghc-options: other-modules: - Cli - Common.Utils - Config.Config - Config.Extras - Instances - Lang.Elm.Config - Lang.Elm.Toml - Lang.Elm.Versions.ElmZeroNineteenOne - Lang.Elm.Writer - Lang.Gleam.Config - Lang.Gleam.Toml - Lang.Gleam.Versions.GleamOneZeroZero - Lang.Gleam.Writer - Lang.Haskell.Config - Lang.Haskell.Toml - Lang.Haskell.Versions.GHCNineEightOne - Lang.Haskell.Writer - Lang.Python.Config - Lang.Python.Toml - Lang.Python.Versions.CPythonThreeTenTwelve - Lang.Python.Writer - Parsing.Parser - Parsing.Types + DataTypeTool.Cli + DataTypeTool.Common.Utils + DataTypeTool.Config.Config + DataTypeTool.Config.Extras + DataTypeTool.Lang.DTT.Config + DataTypeTool.Lang.DTT.Default + DataTypeTool.Lang.Elm.Config + DataTypeTool.Lang.Elm.Toml + DataTypeTool.Lang.Elm.Versions.ElmZeroNineteenOne + DataTypeTool.Lang.Elm.Writer + DataTypeTool.Lang.Gleam.Config + DataTypeTool.Lang.Gleam.Toml + DataTypeTool.Lang.Gleam.Versions.GleamOneZeroZero + DataTypeTool.Lang.Gleam.Writer + DataTypeTool.Lang.Haskell.Config + DataTypeTool.Lang.Haskell.Toml + DataTypeTool.Lang.Haskell.Versions.GHCNineEightOne + DataTypeTool.Lang.Haskell.Writer + DataTypeTool.Lang.Python.Config + DataTypeTool.Lang.Python.Toml + DataTypeTool.Lang.Python.Versions.CPythonThreeTenTwelve + DataTypeTool.Lang.Python.Writer + DataTypeTool.Parsing.Parser + DataTypeTool.Parsing.Types + DataTypeTool.Parsing.Validate Paths_datatypetool Prelude build-depends: - , antelude , aeson + , antelude , base , casing , containers diff --git a/exampleProject/app/DTT/BasicTest.hs b/exampleProject/app/DTT/BasicTest.hs deleted file mode 100644 index 7d53887..0000000 --- a/exampleProject/app/DTT/BasicTest.hs +++ /dev/null @@ -1,83 +0,0 @@ -module DTT.BasicTest where - -{- This file was generated by DataTypeTool -} - -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as AesonT -import Control.Monad.Fail (fail) -import DTT.Folder.AnotherTest - - -{- | - This is a basic Point type. - All of this is a docstring. --} -type Point = (Float, Float) - - -pointEncoder :: Point -> AesonT.Value -pointEncoder = (\(a, b) -> Aeson.object [ ((fromString "first" :: Aeson.Key) Aeson..= (Aeson.toJSON) a), ((fromString "second" :: Aeson.Key) Aeson..= (Aeson.toJSON) b)]) - - -pointDecoder :: AesonT.Value -> AesonT.Parser (Point) -pointDecoder = - (Aeson.withObject "Tuple2" <| \v -> (,) <$> (v Aeson..: (fromString "first" :: Aeson.Key) >>= ((Aeson.parseJSON))) <*> (v Aeson..: (fromString "second" :: Aeson.Key) >>= ((Aeson.parseJSON)))) - - -data CardinalDirections - = North - | South - | East - | West - - -cardinalDirectionsEncoder :: CardinalDirections -> AesonT.Value -cardinalDirectionsEncoder t = case t of - North -> Aeson.toJSON "north" - South -> Aeson.toJSON "south" - East -> Aeson.toJSON "east" - West -> Aeson.toJSON "west" - - -cardinalDirectionsDecoder :: AesonT.Value -> AesonT.Parser (CardinalDirections) -cardinalDirectionsDecoder = Aeson.withText "CardinalDirections" - (\t -> Text.unpack t |> \a -> case a of - "north" -> return <| North - "south" -> return <| South - "east" -> return <| East - "west" -> return <| West - _ -> fail "Invalid string for type CardinalDirections" - ) - - -data ImportantData = ImportantData - { importantDataThis :: String - , importantDataThat :: Maybe Int - , importantDataSomething :: ABC - } - - -importantDataEncoder :: ImportantData -> AesonT.Value -importantDataEncoder val = Aeson.object - [ (fromString "this" :: Aeson.Key) Aeson..= (importantDataThis val |> (Aeson.toJSON)) - , (fromString "that" :: Aeson.Key) Aeson..= (importantDataThat val |> (Aeson.toJSON)) - , (fromString "something" :: Aeson.Key) Aeson..= (importantDataSomething val |> (aBCEncoder) ) - ] - - -importantDataDecoder :: AesonT.Value -> AesonT.Parser (ImportantData) -importantDataDecoder = Aeson.withObject "ImportantData" <| \value -> ImportantData - <$> (value Aeson..: (fromString "this" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "that" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "something" :: Aeson.Key) >>= ((aBCDecoder) )) - - -life :: Int -life = 42 \ No newline at end of file diff --git a/exampleProject/app/DTT/Folder/AnotherTest.hs b/exampleProject/app/DTT/Folder/AnotherTest.hs deleted file mode 100644 index f35c1dc..0000000 --- a/exampleProject/app/DTT/Folder/AnotherTest.hs +++ /dev/null @@ -1,44 +0,0 @@ -module DTT.Folder.AnotherTest where - -{- This file was generated by DataTypeTool -} - -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as AesonT -import Control.Monad.Fail (fail) - - -data ABC - = A - | B - | C - - -aBCEncoder :: ABC -> AesonT.Value -aBCEncoder t = case t of - A -> Aeson.toJSON "a" - B -> Aeson.toJSON "b" - C -> Aeson.toJSON "c" - - -aBCDecoder :: AesonT.Value -> AesonT.Parser (ABC) -aBCDecoder = Aeson.withText "ABC" - (\t -> Text.unpack t |> \a -> case a of - "a" -> return <| A - "b" -> return <| B - "c" -> return <| C - _ -> fail "Invalid string for type ABC" - ) - - -{- | - This is where to find DataTypeTool --} -thisRepo :: String -thisRepo = "https://codeberg.org/dneaves/datatypetool" \ No newline at end of file diff --git a/exampleProject/app/DTT/Folder/ComplexTests.hs b/exampleProject/app/DTT/Folder/ComplexTests.hs deleted file mode 100644 index 5584130..0000000 --- a/exampleProject/app/DTT/Folder/ComplexTests.hs +++ /dev/null @@ -1,41 +0,0 @@ -module DTT.Folder.ComplexTests where - -{- This file was generated by DataTypeTool -} - -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as AesonT -import Control.Monad.Fail (fail) -import DTT.BasicTest - - -data ComplicatedData = ComplicatedData - { complicatedDataBigTuple :: (Maybe String, [Point], Map String Float, Point, ImportantData) - , complicatedDataDirections :: CardinalDirections - , complicatedDataIsTrue :: Bool - } - - -complicatedDataEncoder :: ComplicatedData -> AesonT.Value -complicatedDataEncoder val = Aeson.object - [ (fromString "big_tuple" :: Aeson.Key) Aeson..= (complicatedDataBigTuple val |> (\(a, b, c, d, e) -> Aeson.object [ ((fromString "first" :: Aeson.Key) Aeson..= (Aeson.toJSON) a), ((fromString "second" :: Aeson.Key) Aeson..= (\l -> AesonT.listValue ((pointEncoder) ) l) b), ((fromString "third" :: Aeson.Key) Aeson..= (\d -> Aeson.toJSON d) c), ((fromString "fourth" :: Aeson.Key) Aeson..= (pointEncoder) d), ((fromString "fifth" :: Aeson.Key) Aeson..= (importantDataEncoder) e)])) - , (fromString "directions" :: Aeson.Key) Aeson..= (complicatedDataDirections val |> (cardinalDirectionsEncoder) ) - , (fromString "is_true" :: Aeson.Key) Aeson..= (complicatedDataIsTrue val |> (Aeson.toJSON)) - ] - - -complicatedDataDecoder :: AesonT.Value -> AesonT.Parser (ComplicatedData) -complicatedDataDecoder = Aeson.withObject "ComplicatedData" <| \value -> ComplicatedData - <$> (value Aeson..: (fromString "big_tuple" :: Aeson.Key) >>= ((Aeson.withObject "Tuple5" <| \v -> (,,,,) <$> (v Aeson..: (fromString "first" :: Aeson.Key) >>= ((Aeson.parseJSON))) <*> (v Aeson..: (fromString "second" :: Aeson.Key) >>= ((AesonT.listParser ((pointDecoder) )) )) <*> (v Aeson..: (fromString "third" :: Aeson.Key) >>= ((Aeson.parseJSON))) <*> (v Aeson..: (fromString "fourth" :: Aeson.Key) >>= ((pointDecoder) )) <*> (v Aeson..: (fromString "fifth" :: Aeson.Key) >>= ((importantDataDecoder) ))))) - <*> (value Aeson..: (fromString "directions" :: Aeson.Key) >>= ((cardinalDirectionsDecoder) )) - <*> (value Aeson..: (fromString "is_true" :: Aeson.Key) >>= ((Aeson.parseJSON))) - - -testDict :: Map String String -testDict = Map.fromList [("Key1", "Val1"), ("Key2", "Val2"), ("Key3", "Val3"), ("Key4", "Val4")] \ No newline at end of file diff --git a/exampleProject/app/DTT/TestFile.hs b/exampleProject/app/DTT/TestFile.hs deleted file mode 100644 index a91f52c..0000000 --- a/exampleProject/app/DTT/TestFile.hs +++ /dev/null @@ -1,89 +0,0 @@ -module DTT.TestFile where - -{- This file was generated by DataTypeTool -} - -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as AesonT -import Control.Monad.Fail (fail) - - -data Address = Address - { addressStreet :: String - , addressCity :: String - , addressPostalCode :: String - } - - -addressEncoder :: Address -> AesonT.Value -addressEncoder val = Aeson.object - [ (fromString "street" :: Aeson.Key) Aeson..= (addressStreet val |> (Aeson.toJSON)) - , (fromString "city" :: Aeson.Key) Aeson..= (addressCity val |> (Aeson.toJSON)) - , (fromString "postal_code" :: Aeson.Key) Aeson..= (addressPostalCode val |> (Aeson.toJSON)) - ] - - -addressDecoder :: AesonT.Value -> AesonT.Parser (Address) -addressDecoder = Aeson.withObject "Address" <| \value -> Address - <$> (value Aeson..: (fromString "street" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "city" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "postal_code" :: Aeson.Key) >>= ((Aeson.parseJSON))) - - -{- | - Run tests with test.json. - I got the json from here: https://www.coderstool.com/json-test-data-generator --} -data TestData = TestData - { testDataUid :: String - , testDataName :: String - , testDataDob :: String - , testDataAddress :: Address - , testDataTelephone :: String - , testDataPets :: [String] - , testDataScore :: Float - , testDataEmail :: String - , testDataUrl :: String - , testDataDescription :: String - , testDataVerified :: Bool - , testDataSalary :: Int - } - - -testDataEncoder :: TestData -> AesonT.Value -testDataEncoder val = Aeson.object - [ (fromString "uid" :: Aeson.Key) Aeson..= (testDataUid val |> (Aeson.toJSON)) - , (fromString "name" :: Aeson.Key) Aeson..= (testDataName val |> (Aeson.toJSON)) - , (fromString "dob" :: Aeson.Key) Aeson..= (testDataDob val |> (Aeson.toJSON)) - , (fromString "address" :: Aeson.Key) Aeson..= (testDataAddress val |> (addressEncoder) ) - , (fromString "telephone" :: Aeson.Key) Aeson..= (testDataTelephone val |> (Aeson.toJSON)) - , (fromString "pets" :: Aeson.Key) Aeson..= (testDataPets val |> (\l -> AesonT.listValue ((Aeson.toJSON)) l) ) - , (fromString "score" :: Aeson.Key) Aeson..= (testDataScore val |> (Aeson.toJSON)) - , (fromString "email" :: Aeson.Key) Aeson..= (testDataEmail val |> (Aeson.toJSON)) - , (fromString "url" :: Aeson.Key) Aeson..= (testDataUrl val |> (Aeson.toJSON)) - , (fromString "description" :: Aeson.Key) Aeson..= (testDataDescription val |> (Aeson.toJSON)) - , (fromString "verified" :: Aeson.Key) Aeson..= (testDataVerified val |> (Aeson.toJSON)) - , (fromString "salary" :: Aeson.Key) Aeson..= (testDataSalary val |> (Aeson.toJSON)) - ] - - -testDataDecoder :: AesonT.Value -> AesonT.Parser (TestData) -testDataDecoder = Aeson.withObject "TestData" <| \value -> TestData - <$> (value Aeson..: (fromString "uid" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "name" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "dob" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "address" :: Aeson.Key) >>= ((addressDecoder) )) - <*> (value Aeson..: (fromString "telephone" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "pets" :: Aeson.Key) >>= ((AesonT.listParser ((Aeson.parseJSON))) )) - <*> (value Aeson..: (fromString "score" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "email" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "url" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "description" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "verified" :: Aeson.Key) >>= ((Aeson.parseJSON))) - <*> (value Aeson..: (fromString "salary" :: Aeson.Key) >>= ((Aeson.parseJSON))) \ No newline at end of file diff --git a/exampleProject/app/Main.hs b/exampleProject/app/Main.hs deleted file mode 100644 index b505175..0000000 --- a/exampleProject/app/Main.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Main where - -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as AesonT -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy as BSL -import qualified Data.Map.Strict as Map -import Data.String (fromString) -import qualified DTT.TestFile as Test - -main :: IO () -main = do - case testJson of - Just t -> do - decoded <- return <| AesonT.parseMaybe Test.testDataDecoder t - case decoded of - Just d -> do - reencoded <- return <| Test.testDataEncoder d - print <| Aeson.encode reencoded - print "" - print (t == reencoded) - Nothing -> - print "decoded was not Just" - Nothing -> - print "testData was not Just" - - -testJson :: Maybe Aeson.Value -testJson = Aeson.decode' <| fromString "{\"uid\": \"1NZR6G48Q7086GKV\",\"name\": \"Sylvia Valenti\",\"dob\": \"2015-12-02\",\"address\": {\"street\": \"9176 Wincombe Street\",\"city\": \"Uppingham\",\"postal_code\": \"SY5 7PF\"},\"telephone\": \"+53-4720-814-866\",\"pets\": [\"Blackie\",\"Riley\"],\"score\": 5.5,\"email\": \"sade6144@freeze.nh.us\",\"url\": \"http://portable.trentinosud-tirol.it\",\"description\": \"cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian\",\"verified\": true,\"salary\": 67737}" diff --git a/exampleProject/app/dtt/basic_test.py b/exampleProject/app/dtt/basic_test.py deleted file mode 100644 index 2d8069b..0000000 --- a/exampleProject/app/dtt/basic_test.py +++ /dev/null @@ -1,82 +0,0 @@ -# This file was generated by DataTypeTool - -from json import (JSONDecodeError, loads, dumps) -from enum import Enum -from dataclasses import dataclass -import typing -from folder.another_test import (ABC, a_b_c_encoder, a_b_c_decoder) - - -# This is a basic Point type. -# All of this is a docstring. -Point: typing.TypeAlias = tuple[float, float] - - -def point_encoder(obj: Point) -> str: - return dumps((lambda t: { "first": float(t[0]), "second": float(t[1])})(obj)) - - -def point_decoder(json_val: str | bytes | bytearray) -> Point | typing.NoReturn: - return (lambda tup_json: (float(tup_json.get("first")), float(tup_json.get("second"))))(json_val) or None - - -class CardinalDirections(Enum): - North = "north" - South = "south" - East = "east" - West = "west" - - -def cardinal_directions_encoder(obj: CardinalDirections) -> str: - match obj: - case CardinalDirections.North: - return dumps("north") - case CardinalDirections.South: - return dumps("south") - case CardinalDirections.East: - return dumps("east") - case CardinalDirections.West: - return dumps("west") - - -def cardinal_directions_decoder(json_val: typing.Union[str, bytes, bytearray]) -> CardinalDirections | typing.NoReturn: - match loads(json_val): - case "north": - return CardinalDirections.North - case "south": - return CardinalDirections.South - case "east": - return CardinalDirections.East - case "west": - return CardinalDirections.West - case err: - raise JSONDecodeError( - f"Expected one of: \"north\", \"south\", \"east\", \"west\", Found: {err}", json_val, None - ) - - -@dataclass -class ImportantData: - this: str - that: int | None - something: ABC - - -def important_data_encoder(obj: ImportantData) -> str: - return dumps({ - "this": str(obj.this), - "that": (lambda n: int(n) if n is not None else None)(obj.that), - "something": (lambda dt: loads(a_b_c_encoder(dt)))(obj.something) - }) - - -def important_data_decoder(json_val: typing.Union[str, bytes, bytearray, dict]) -> ImportantData | typing.NoReturn: - json_dict = loads(json_val) if not isinstance(json_val, dict) else json_val - return ImportantData( - this = str(json_dict.get("this")), - that = (lambda n: int(n) if n is not None else None)(json_dict.get("that")), - something = a_b_c_decoder(json_dict.get("something")) - ) - - -LIFE: typing.Final[int] = 42 \ No newline at end of file diff --git a/exampleProject/app/dtt/folder/another_test.py b/exampleProject/app/dtt/folder/another_test.py deleted file mode 100644 index 3515003..0000000 --- a/exampleProject/app/dtt/folder/another_test.py +++ /dev/null @@ -1,40 +0,0 @@ -# This file was generated by DataTypeTool - -from json import (JSONDecodeError, loads, dumps) -from enum import Enum -from dataclasses import dataclass -import typing - - -class ABC(Enum): - A = "a" - B = "b" - C = "c" - - -def a_b_c_encoder(obj: ABC) -> str: - match obj: - case ABC.A: - return dumps("a") - case ABC.B: - return dumps("b") - case ABC.C: - return dumps("c") - - -def a_b_c_decoder(json_val: typing.Union[str, bytes, bytearray]) -> ABC | typing.NoReturn: - match loads(json_val): - case "a": - return ABC.A - case "b": - return ABC.B - case "c": - return ABC.C - case err: - raise JSONDecodeError( - f"Expected one of: \"a\", \"b\", \"c\", Found: {err}", json_val, None - ) - - -# This is where to find DataTypeTool -THIS_REPO: typing.Final[str] = "https://codeberg.org/dneaves/datatypetool" \ No newline at end of file diff --git a/exampleProject/app/dtt/folder/complex_tests.py b/exampleProject/app/dtt/folder/complex_tests.py deleted file mode 100644 index 966550b..0000000 --- a/exampleProject/app/dtt/folder/complex_tests.py +++ /dev/null @@ -1,34 +0,0 @@ -# This file was generated by DataTypeTool - -from json import (JSONDecodeError, loads, dumps) -from enum import Enum -from dataclasses import dataclass -import typing -from basic_test import (Point, point_encoder, point_decoder, CardinalDirections, cardinal_directions_encoder, cardinal_directions_decoder, ImportantData, important_data_encoder, important_data_decoder) - - -@dataclass -class ComplicatedData: - big_tuple: tuple[str | None, list[Point], dict[str, float], Point, ImportantData] - directions: CardinalDirections - is_true: bool - - -def complicated_data_encoder(obj: ComplicatedData) -> str: - return dumps({ - "big_tuple": (lambda t: { "first": (lambda n: str(n) if n is not None else None)(t[0]), "second": (lambda l: [(lambda dt: loads(point_encoder(dt)))(lj) for lj in l])(t[1]), "third": (lambda l: [(lambda dt: loads(point_encoder(dt)))(lj) for lj in l])(t[2]), "fourth": (lambda l: [(lambda dt: loads(point_encoder(dt)))(lj) for lj in l])(t[3]), "fifth": (lambda l: [(lambda dt: loads(point_encoder(dt)))(lj) for lj in l])(t[4])})(obj.big_tuple), - "directions": (lambda dt: loads(cardinal_directions_encoder(dt)))(obj.directions), - "is_true": bool(obj.is_true) - }) - - -def complicated_data_decoder(json_val: typing.Union[str, bytes, bytearray, dict]) -> ComplicatedData | typing.NoReturn: - json_dict = loads(json_val) if not isinstance(json_val, dict) else json_val - return ComplicatedData( - big_tuple = (lambda tup_json: ((lambda n: str(n) if n is not None else None)(tup_json.get("first")), (lambda list_json: [point_decoder(l) for l in list_json])(tup_json.get("second")), (lambda dict_json: {k: float(v) for k, v in dict_json})(tup_json.get("third")), point_decoder(tup_json.get("fourth")), important_data_decoder(tup_json.get("fifth"))))(json_dict.get("big_tuple")), - directions = cardinal_directions_decoder(json_dict.get("directions")), - is_true = bool(json_dict.get("is_true")) - ) - - -TEST_DICT: typing.Final[dict[str, str]] = {#(Key1, "Val1"), #(Key2, "Val2"), #(Key3, "Val3"), #(Key4, "Val4")} \ No newline at end of file diff --git a/exampleProject/app/dtt/test_file.py b/exampleProject/app/dtt/test_file.py deleted file mode 100644 index d7c2ccb..0000000 --- a/exampleProject/app/dtt/test_file.py +++ /dev/null @@ -1,85 +0,0 @@ -# This file was generated by DataTypeTool - -from json import (JSONDecodeError, loads, dumps) -from enum import Enum -from dataclasses import dataclass -import typing - - -@dataclass -class Address: - street: str - city: str - postal_code: str - - -def address_encoder(obj: Address) -> str: - return dumps({ - "street": str(obj.street), - "city": str(obj.city), - "postal_code": str(obj.postal_code) - }) - - -def address_decoder(json_val: typing.Union[str, bytes, bytearray, dict]) -> Address | typing.NoReturn: - json_dict = loads(json_val) if not isinstance(json_val, dict) else json_val - return Address( - street = str(json_dict.get("street")), - city = str(json_dict.get("city")), - postal_code = str(json_dict.get("postal_code")) - ) - - -@dataclass -class TestData: - """ - Run tests with test.json. - I got the json from here: https://www.coderstool.com/json-test-data-generator - """ - uid: str - name: str - dob: str - address: Address - telephone: str - pets: list[str] - score: float - email: str - url: str - description: str - verified: bool - salary: int - - -def test_data_encoder(obj: TestData) -> str: - return dumps({ - "uid": str(obj.uid), - "name": str(obj.name), - "dob": str(obj.dob), - "address": (lambda dt: loads(address_encoder(dt)))(obj.address), - "telephone": str(obj.telephone), - "pets": (lambda l: [str(lj) for lj in l])(obj.pets), - "score": float(obj.score), - "email": str(obj.email), - "url": str(obj.url), - "description": str(obj.description), - "verified": bool(obj.verified), - "salary": int(obj.salary) - }) - - -def test_data_decoder(json_val: typing.Union[str, bytes, bytearray, dict]) -> TestData | typing.NoReturn: - json_dict = loads(json_val) if not isinstance(json_val, dict) else json_val - return TestData( - uid = str(json_dict.get("uid")), - name = str(json_dict.get("name")), - dob = str(json_dict.get("dob")), - address = address_decoder(json_dict.get("address")), - telephone = str(json_dict.get("telephone")), - pets = (lambda list_json: [str(l) for l in list_json])(json_dict.get("pets")), - score = float(json_dict.get("score")), - email = str(json_dict.get("email")), - url = str(json_dict.get("url")), - description = str(json_dict.get("description")), - verified = bool(json_dict.get("verified")), - salary = int(json_dict.get("salary")) - ) \ No newline at end of file diff --git a/exampleProject/datatypetool.toml b/exampleProject/datatypetool.toml index 65f2ea5..8336bb1 100644 --- a/exampleProject/datatypetool.toml +++ b/exampleProject/datatypetool.toml @@ -1,35 +1,20 @@ [datatypetool] -# Location relative to this -# datatypetool.toml file. -sources = 'types' - -spacing = "spaces3" +# Where are the types defined relative to this file? +sources = "types" +# How many spaces are an indent? +# Can be "spaces2", "spaces3", "spaces4", or "tabs" +spacing = "spaces4" [targets] - -[targets.python] - -output_location = 'app' -lang_version = "3.10.12" - +# All 'targets' have "output_location" and "lang_version" as common, required options# You define your output languages here like the following: +# [targets.haskell] +# output_location = "app" +# lang_version = "9.8.1" +# +# Some languages have extra configuration options +# Please check the wiki for what can be configured [targets.elm] - -output_location = 'src' +output_location = "src" lang_version = "0.19.1" - -[targets.haskell] - -output_location = 'app' -lang_version = "9.8.1" - -[targets.gleam] - -output_location = 'src' -lang_version = "1.0.0" - -# Try to use libraries for a certain -# backend, e.g.: "javascript" or "erlang". -preferred_backend = "erlang" - diff --git a/exampleProject/elm.json b/exampleProject/elm.json index 0a0e9a0..ce2a08d 100644 --- a/exampleProject/elm.json +++ b/exampleProject/elm.json @@ -6,20 +6,15 @@ "elm-version": "0.19.1", "dependencies": { "direct": { - "NoRedInk/elm-json-decode-pipeline": "1.0.1", - "albertdahlin/elm-posix": "1.1.0", "elm/browser": "1.0.2", "elm/core": "1.0.5", - "elm/html": "1.0.0", - "elm/json": "1.1.3", - "elm-community/json-extra": "4.3.0" + "elm/html": "1.0.0" }, "indirect": { - "elm/parser": "1.1.0", + "elm/json": "1.1.3", "elm/time": "1.0.0", "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.3", - "rtfeldman/elm-iso8601-date-strings": "1.1.4" + "elm/virtual-dom": "1.0.3" } }, "test-dependencies": { diff --git a/exampleProject/exampleProject.cabal b/exampleProject/exampleProject.cabal deleted file mode 100644 index c9a50da..0000000 --- a/exampleProject/exampleProject.cabal +++ /dev/null @@ -1,22 +0,0 @@ -cabal-version: 3.4 -name: exampleProject -version: 0.1.0.0 - -common warnings - ghc-options: -Wall - -executable testProject - import: warnings - main-is: Main.hs - mixins: base hiding (Prelude) - , antelude (Antelude as Prelude) - , antelude - build-depends: base ^>=4.19.1.0 - , antelude - , aeson - , bytestring - , containers - , text - , unordered-containers - hs-source-dirs: app - default-language: GHC2021 diff --git a/exampleProject/gleam.toml b/exampleProject/gleam.toml deleted file mode 100644 index b9305a0..0000000 --- a/exampleProject/gleam.toml +++ /dev/null @@ -1,20 +0,0 @@ -name = "test_project" -version = "1.0.0" - -# Fill out these fields if you intend to generate HTML documentation or publish -# your project to the Hex package manager. -# -# description = "" -# licences = ["Apache-2.0"] -# repository = { type = "github", user = "username", repo = "project" } -# links = [{ title = "Website", href = "https://gleam.run" }] -# -# For a full reference of all the available options, you can have a look at -# https://gleam.run/writing-gleam/gleam-toml/. - -[dependencies] -gleam_stdlib = "~> 0.34 or ~> 1.0" -gleam_json = "~> 1.0" - -[dev-dependencies] -gleeunit = "~> 1.0" diff --git a/exampleProject/manifest.toml b/exampleProject/manifest.toml deleted file mode 100644 index a79ba17..0000000 --- a/exampleProject/manifest.toml +++ /dev/null @@ -1,14 +0,0 @@ -# This file was generated by Gleam -# You typically do not need to edit this file - -packages = [ - { name = "gleam_json", version = "1.0.0", build_tools = ["gleam"], requirements = ["gleam_stdlib", "thoas"], otp_app = "gleam_json", source = "hex", outer_checksum = "8B197DD5D578EA6AC2C0D4BDC634C71A5BCA8E7DB5F47091C263ECB411A60DF3" }, - { name = "gleam_stdlib", version = "0.36.0", build_tools = ["gleam"], requirements = [], otp_app = "gleam_stdlib", source = "hex", outer_checksum = "C0D14D807FEC6F8A08A7C9EF8DFDE6AE5C10E40E21325B2B29365965D82EB3D4" }, - { name = "gleeunit", version = "1.1.2", build_tools = ["gleam"], requirements = ["gleam_stdlib"], otp_app = "gleeunit", source = "hex", outer_checksum = "72CDC3D3F719478F26C4E2C5FED3E657AC81EC14A47D2D2DEBB8693CA3220C3B" }, - { name = "thoas", version = "0.4.1", build_tools = ["rebar3"], requirements = [], otp_app = "thoas", source = "hex", outer_checksum = "4918D50026C073C4AB1388437132C77A6F6F7C8AC43C60C13758CC0ADCE2134E" }, -] - -[requirements] -gleam_json = { version = "~> 1.0" } -gleam_stdlib = { version = "~> 0.34 or ~> 1.0" } -gleeunit = { version = "~> 1.0" } diff --git a/exampleProject/notes.md b/exampleProject/notes.md deleted file mode 100644 index e6127e0..0000000 --- a/exampleProject/notes.md +++ /dev/null @@ -1,11 +0,0 @@ -Python -{"uid": "1NZR6G48Q7086GKV", "name": "Sylvia Valenti", "dob": "2015-12-02", "address": {"street": "9176 Wincombe Street", "city": "Uppingham", "postal_code": "SY5 7PF"}, "telephone": "+53-4720-814-866", "pets": ["Blackie", "Riley"], "score": 5.5, "email": "sade6144@freeze.nh.us", "url": "http: //portable.trentinosud-tirol.it", "description": "cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian", "verified": true, "salary": 67737} - -Gleam -{"uid": "1NZR6G48Q7086GKV", "name": "Sylvia Valenti", "dob": "2015-12-02", "address": {"street": "9176 Wincombe Street", "city": "Uppingham", "postal_code": "SY5 7PF"}, "telephone": "+53-4720-814-866", "pets": ["Blackie", "Riley"], "score": 5.5, "email": "sade6144@freeze.nh.us", "url": "http: //portable.trentinosud-tirol.it", "description": "cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian", "verified": true, "salary": 67737} - -Elm -{"uid": "1NZR6G48Q7086GKV", "name": "Sylvia Valenti", "dob": "2015-12-02", "address": {"street": "9176 Wincombe Street", "city": "Uppingham", "postal_code": "SY5 7PF"}, "telephone": "+53-4720-814-866", "pets": ["Blackie", "Riley"], "score": 5.5, "email": "sade6144@freeze.nh.us", "url": "http: //portable.trentinosud-tirol.it", "description": "cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian", "verified": true, "salary": 67737} - -Haskell (As a printed ByteString, aka already encoded) -"{\"address\":{\"city\":\"Uppingham\",\"postal_code\":\"SY5 7PF\",\"street\":\"9176 Wincombe Street\"},\"description\":\"cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian\",\"dob\":\"2015-12-02\",\"email\":\"sade6144@freeze.nh.us\",\"name\":\"Sylvia Valenti\",\"pets\":[\"Blackie\",\"Riley\"],\"salary\":67737,\"score\":5.5,\"telephone\":\"+53-4720-814-866\",\"uid\":\"1NZR6G48Q7086GKV\",\"url\":\"http://portable.trentinosud-tirol.it\",\"verified\":true}" \ No newline at end of file diff --git a/exampleProject/runtest.py b/exampleProject/runtest.py deleted file mode 100755 index 3df37fb..0000000 --- a/exampleProject/runtest.py +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/env python3.10 - -import app.dtt.test_file as tester -import json - -TEST_JSON = """{ - "uid": "1NZR6G48Q7086GKV", - "name": "Sylvia Valenti", - "dob": "2015-12-02", - "address": { - "street": "9176 Wincombe Street", - "city": "Uppingham", - "postal_code": "SY5 7PF" - }, - "telephone": "+53-4720-814-866", - "pets": [ - "Blackie", - "Riley" - ], - "score": 5.5, - "email": "sade6144@freeze.nh.us", - "url": "http://portable.trentinosud-tirol.it", - "description": "cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian", - "verified": true, - "salary": 67737 -}""" - -if __name__ == "__main__": - test_json = json.dumps(json.loads(TEST_JSON)) - print(test_json) - decoded = tester.test_data_decoder(test_json) - print(decoded) - reencoded = tester.test_data_encoder(decoded) - print(reencoded) - print("Equal?", reencoded == test_json) \ No newline at end of file diff --git a/exampleProject/src/DTT/BasicTest.elm b/exampleProject/src/DTT/BasicTest.elm deleted file mode 100644 index 6b3aa24..0000000 --- a/exampleProject/src/DTT/BasicTest.elm +++ /dev/null @@ -1,84 +0,0 @@ -module DTT.BasicTest exposing (..) - -{- This file was generated by DataTypeTool -} - -import Dict exposing (Dict) -import Set exposing (Set) -import Json.Decode as JD -import Json.Encode as JE -import Json.Decode.Extra as JDE -import Json.Encode.Extra as JEE -import Json.Decode.Pipeline as JDP -import DTT.Folder.AnotherTest exposing (ABC, aBCEncoder, aBCDecoder) - - -{- - This is a basic Point type. - All of this is a docstring. --} -type alias Point = (Float, Float) - - -pointEncoder : Point -> JE.Value -pointEncoder val = - (\(a, b) -> JE.object [("first", (JE.float) a), ("second", (JE.float) b)]) val - - -pointDecoder : JD.Decoder Point -pointDecoder = (JD.map2 (\a b -> (a, b)) (JD.field "first" ((JD.float))) (JD.field "second" ((JD.float)))) - - -type CardinalDirections - = North - | South - | East - | West - - -cardinalDirectionsEncoder : CardinalDirections -> JE.Value -cardinalDirectionsEncoder val = - case val of - North -> JE.string "north" - South -> JE.string "south" - East -> JE.string "east" - West -> JE.string "west" - - -cardinalDirectionsDecoder : JD.Decoder CardinalDirections -cardinalDirectionsDecoder = JD.string - |> JD.andThen - (\strEnum -> case strEnum of - "north" -> JD.succeed North - "south" -> JD.succeed South - "east" -> JD.succeed East - "west" -> JD.succeed West - _ -> JD.fail "Could not find matching string for type CardinalDirections" - ) - - -type alias ImportantData = - { this : String - , that : Maybe Int - , something : ABC - } - - -importantDataEncoder : ImportantData -> JE.Value -importantDataEncoder val = - JE.object - [ ( "this", (JE.string) val.this) - , ( "that", (JEE.maybe ((JE.int))) val.that) - , ( "something", aBCEncoder val.something) - ] - - -importantDataDecoder : JD.Decoder ImportantData -importantDataDecoder = - JD.succeed ImportantData - |> JDP.required "this" ((JD.string)) - |> JDP.required "that" ((JD.nullable (JD.int))) - |> JDP.required "something" (aBCDecoder) - - -life : Int -life = 42 \ No newline at end of file diff --git a/exampleProject/src/DTT/Example.elm b/exampleProject/src/DTT/Example.elm new file mode 100644 index 0000000..acfc488 --- /dev/null +++ b/exampleProject/src/DTT/Example.elm @@ -0,0 +1,44 @@ +module DTT.Example exposing (..) + +{- This file was generated by DataTypeTool -} + +import Dict exposing (Dict) +import Set exposing (Set) +import Json.Decode as JD +import Json.Encode as JE +import Json.Decode.Extra as JDE +import Json.Encode.Extra as JEE +import Json.Decode.Pipeline as JDP + + +type alias People = + { firstName : String + , lastName : String + , age : Int + } + + + + + + + + +type Answers + = Yes + | No + | Unsure + + + + + + + + +type alias Point = (Float, Float) + + + + + diff --git a/exampleProject/src/DTT/Folder/AnotherTest.elm b/exampleProject/src/DTT/Folder/AnotherTest.elm deleted file mode 100644 index 730a8c8..0000000 --- a/exampleProject/src/DTT/Folder/AnotherTest.elm +++ /dev/null @@ -1,43 +0,0 @@ -module DTT.Folder.AnotherTest exposing (..) - -{- This file was generated by DataTypeTool -} - -import Dict exposing (Dict) -import Set exposing (Set) -import Json.Decode as JD -import Json.Encode as JE -import Json.Decode.Extra as JDE -import Json.Encode.Extra as JEE -import Json.Decode.Pipeline as JDP - - -type ABC - = A - | B - | C - - -aBCEncoder : ABC -> JE.Value -aBCEncoder val = - case val of - A -> JE.string "a" - B -> JE.string "b" - C -> JE.string "c" - - -aBCDecoder : JD.Decoder ABC -aBCDecoder = JD.string - |> JD.andThen - (\strEnum -> case strEnum of - "a" -> JD.succeed A - "b" -> JD.succeed B - "c" -> JD.succeed C - _ -> JD.fail "Could not find matching string for type ABC" - ) - - -{- - This is where to find DataTypeTool --} -thisRepo : String -thisRepo = "https://codeberg.org/dneaves/datatypetool" \ No newline at end of file diff --git a/exampleProject/src/DTT/Folder/ComplexTests.elm b/exampleProject/src/DTT/Folder/ComplexTests.elm deleted file mode 100644 index fbeeb62..0000000 --- a/exampleProject/src/DTT/Folder/ComplexTests.elm +++ /dev/null @@ -1,40 +0,0 @@ -module DTT.Folder.ComplexTests exposing (..) - -{- This file was generated by DataTypeTool -} - -import Dict exposing (Dict) -import Set exposing (Set) -import Json.Decode as JD -import Json.Encode as JE -import Json.Decode.Extra as JDE -import Json.Encode.Extra as JEE -import Json.Decode.Pipeline as JDP -import DTT.BasicTest exposing (Point, pointEncoder, pointDecoder, CardinalDirections, cardinalDirectionsEncoder, cardinalDirectionsDecoder, ImportantData, importantDataEncoder, importantDataDecoder) - - -type alias ComplicatedData = - { bigTuple : (Maybe String, List Point, Dict String Float, Point, ImportantData) - , directions : CardinalDirections - , isTrue : Bool - } - - -complicatedDataEncoder : ComplicatedData -> JE.Value -complicatedDataEncoder val = - JE.object - [ ( "big_tuple", (\(a, b, c, d, e) -> JE.object [("first", (JEE.maybe ((JE.string))) a), ("second", (JE.list (pointEncoder)) b), ("third", (JE.dict identity ((JE.float))) c), ("fourth", pointEncoder d), ("fifth", importantDataEncoder e)]) val.bigTuple) - , ( "directions", cardinalDirectionsEncoder val.directions) - , ( "is_true", (JE.bool) val.isTrue) - ] - - -complicatedDataDecoder : JD.Decoder ComplicatedData -complicatedDataDecoder = - JD.succeed ComplicatedData - |> JDP.required "big_tuple" ((JD.map5 (\a b c d e -> (a, b, c, d, e)) (JD.field "first" ((JD.nullable (JD.string)))) (JD.field "second" ((JD.list (pointDecoder)))) (JD.field "third" ((JD.dict ((JD.float))))) (JD.field "fourth" (pointDecoder)) (JD.field "fifth" (importantDataDecoder)))) - |> JDP.required "directions" (cardinalDirectionsDecoder) - |> JDP.required "is_true" ((JD.bool)) - - -testDict : Dict String String -testDict = Dict.fromList [("Key1", "Val1"), ("Key2", "Val2"), ("Key3", "Val3"), ("Key4", "Val4")] \ No newline at end of file diff --git a/exampleProject/src/DTT/TestFile.elm b/exampleProject/src/DTT/TestFile.elm deleted file mode 100644 index 650c0fd..0000000 --- a/exampleProject/src/DTT/TestFile.elm +++ /dev/null @@ -1,90 +0,0 @@ -module DTT.TestFile exposing (..) - -{- This file was generated by DataTypeTool -} - -import Dict exposing (Dict) -import Set exposing (Set) -import Json.Decode as JD -import Json.Encode as JE -import Json.Decode.Extra as JDE -import Json.Encode.Extra as JEE -import Json.Decode.Pipeline as JDP - - -type alias Address = - { street : String - , city : String - , postalCode : String - } - - -addressEncoder : Address -> JE.Value -addressEncoder val = - JE.object - [ ( "street", (JE.string) val.street) - , ( "city", (JE.string) val.city) - , ( "postal_code", (JE.string) val.postalCode) - ] - - -addressDecoder : JD.Decoder Address -addressDecoder = - JD.succeed Address - |> JDP.required "street" ((JD.string)) - |> JDP.required "city" ((JD.string)) - |> JDP.required "postal_code" ((JD.string)) - - -{- - Run tests with test.json. - I got the json from here: https://www.coderstool.com/json-test-data-generator --} -type alias TestData = - { uid : String - , name : String - , dob : String - , address : Address - , telephone : String - , pets : List String - , score : Float - , email : String - , url : String - , description : String - , verified : Bool - , salary : Int - } - - -testDataEncoder : TestData -> JE.Value -testDataEncoder val = - JE.object - [ ( "uid", (JE.string) val.uid) - , ( "name", (JE.string) val.name) - , ( "dob", (JE.string) val.dob) - , ( "address", addressEncoder val.address) - , ( "telephone", (JE.string) val.telephone) - , ( "pets", (JE.list ((JE.string))) val.pets) - , ( "score", (JE.float) val.score) - , ( "email", (JE.string) val.email) - , ( "url", (JE.string) val.url) - , ( "description", (JE.string) val.description) - , ( "verified", (JE.bool) val.verified) - , ( "salary", (JE.int) val.salary) - ] - - -testDataDecoder : JD.Decoder TestData -testDataDecoder = - JD.succeed TestData - |> JDP.required "uid" ((JD.string)) - |> JDP.required "name" ((JD.string)) - |> JDP.required "dob" ((JD.string)) - |> JDP.required "address" (addressDecoder) - |> JDP.required "telephone" ((JD.string)) - |> JDP.required "pets" ((JD.list ((JD.string)))) - |> JDP.required "score" ((JD.float)) - |> JDP.required "email" ((JD.string)) - |> JDP.required "url" ((JD.string)) - |> JDP.required "description" ((JD.string)) - |> JDP.required "verified" ((JD.bool)) - |> JDP.required "salary" ((JD.int)) \ No newline at end of file diff --git a/exampleProject/src/ElmTest.elm b/exampleProject/src/ElmTest.elm deleted file mode 100644 index 71734b8..0000000 --- a/exampleProject/src/ElmTest.elm +++ /dev/null @@ -1,59 +0,0 @@ -{- Uses elm-posix to test this: https://github.com/albertdahlin/elm-posix/tree/master - elm-cli run src/ElmTest.elm --} - - -module ElmTest exposing (program) - -import DTT.TestFile as TF -import Json.Decode as JD -import Json.Decode.Pipeline as JDP -import Json.Encode as JE -import Posix.IO as IO exposing (IO, Process) -import Posix.IO.Process as IOP - - -program : Process -> IO () -program process = - let - decodeJson = - JD.decodeString TF.testDataDecoder testJson - |> (\tdd -> - case tdd of - Err err -> - IOP.print "Error!" - - Ok ok -> - TF.testDataEncoder ok |> JE.encode 0 |> IOP.print - ) - in - IOP.print testJson - |> IO.andThen - (\_ -> - decodeJson - ) - - -testJson : String -testJson = - """{ - "uid": "1NZR6G48Q7086GKV", - "name": "Sylvia Valenti", - "dob": "2015-12-02", - "address": { - "street": "9176 Wincombe Street", - "city": "Uppingham", - "postal_code": "SY5 7PF" - }, - "telephone": "+53-4720-814-866", - "pets": [ - "Blackie", - "Riley" - ], - "score": 5.5, - "email": "sade6144@freeze.nh.us", - "url": "http://portable.trentinosud-tirol.it", - "description": "cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian", - "verified": true, - "salary": 67737 -}""" diff --git a/exampleProject/src/dtt/basic_test.gleam b/exampleProject/src/dtt/basic_test.gleam deleted file mode 100644 index 2b4c80e..0000000 --- a/exampleProject/src/dtt/basic_test.gleam +++ /dev/null @@ -1,90 +0,0 @@ -//// This file was generated by DataTypeTool - -import gleam/dict.{type Dict} -import gleam/set.{type Set} -import gleam/dynamic.{type Dynamic, type DecodeError} -import gleam/json.{type Json} -import gleam/option.{type Option} -import gleam/result.{try} -import dtt/folder/another_test.{type ABC, a_b_c_encoder, a_b_c_decoder} - - -/// This is a basic Point type. -/// All of this is a docstring. -pub type Point = #(Float, Float) - - -pub fn point_encoder(point: Point) -> Json { - fn(t){let #(a,b) = t json.object([#("first", json.float(a)), #("second", json.float(b))])}(point) -} - - -pub fn point_decoder(json: Dynamic) -> Result(Point, List(DecodeError)) { - fn(t2json){use a <- try(dynamic.field("first", dynamic.float)(t2json)) use b <- try(dynamic.field("second", dynamic.float)(t2json)) Ok(#(a, b))}(json) -} - - -pub type CardinalDirections { - North - South - East - West -} - - -pub fn cardinal_directions_encoder(cardinal_directions: CardinalDirections) -> Json { - case cardinal_directions { - North -> json.string("north") - South -> json.string("south") - East -> json.string("east") - West -> json.string("west") - } -} - - -pub fn cardinal_directions_decoder(json: Dynamic) -> Result(CardinalDirections, List(DecodeError)) { - use enum_str <- result.try(dynamic.string(json)) - case enum_str { - "north" -> Ok(North) - "south" -> Ok(South) - "east" -> Ok(East) - "west" -> Ok(West) - err -> Error( - [dynamic.DecodeError( - "Expected one of: \"north\", \"south\", \"east\", \"west\"", - "Found: " <> err, - [] - )] - ) - } -} - - -pub type ImportantData { - ImportantData( - this: String, - that: Option(Int), - something: ABC - ) -} - - -pub fn important_data_encoder(important_data: ImportantData) -> Json { - json.object([ - #("this", json.string(important_data.this)), - #("that", fn(n){json.nullable(n, json.int)}(important_data.that)), - #("something", a_b_c_encoder(important_data.something)) - ]) -} - - -pub fn important_data_decoder(json: Dynamic) -> Result(ImportantData, List(DecodeError)) { - use this <- try(dynamic.field("this", dynamic.string)(json)) - use that <- try(dynamic.field("that", dynamic.optional(dynamic.int))(json)) - use something <- try(dynamic.field("something", a_b_c_decoder)(json)) - Ok(ImportantData(this, that, something)) -} - - -/// Temporarily a function solely because Dict's cant be constructed free-hand. -pub fn life() -> Int {42} \ No newline at end of file diff --git a/exampleProject/src/dtt/folder/another_test.gleam b/exampleProject/src/dtt/folder/another_test.gleam deleted file mode 100644 index 99f00ca..0000000 --- a/exampleProject/src/dtt/folder/another_test.gleam +++ /dev/null @@ -1,46 +0,0 @@ -//// This file was generated by DataTypeTool - -import gleam/dict.{type Dict} -import gleam/set.{type Set} -import gleam/dynamic.{type Dynamic, type DecodeError} -import gleam/json.{type Json} -import gleam/option.{type Option} -import gleam/result.{try} - - -pub type ABC { - A - B - C -} - - -pub fn a_b_c_encoder(a_b_c: ABC) -> Json { - case a_b_c { - A -> json.string("a") - B -> json.string("b") - C -> json.string("c") - } -} - - -pub fn a_b_c_decoder(json: Dynamic) -> Result(ABC, List(DecodeError)) { - use enum_str <- result.try(dynamic.string(json)) - case enum_str { - "a" -> Ok(A) - "b" -> Ok(B) - "c" -> Ok(C) - err -> Error( - [dynamic.DecodeError( - "Expected one of: \"a\", \"b\", \"c\"", - "Found: " <> err, - [] - )] - ) - } -} - - -/// This is where to find DataTypeTool -/// Temporarily a function solely because Dict's cant be constructed free-hand. -pub fn this_repo() -> String {"https://codeberg.org/dneaves/datatypetool"} \ No newline at end of file diff --git a/exampleProject/src/dtt/folder/complex_tests.gleam b/exampleProject/src/dtt/folder/complex_tests.gleam deleted file mode 100644 index 6e93ae4..0000000 --- a/exampleProject/src/dtt/folder/complex_tests.gleam +++ /dev/null @@ -1,39 +0,0 @@ -//// This file was generated by DataTypeTool - -import gleam/dict.{type Dict} -import gleam/set.{type Set} -import gleam/dynamic.{type Dynamic, type DecodeError} -import gleam/json.{type Json} -import gleam/option.{type Option} -import gleam/result.{try} -import dtt/basic_test.{type Point, point_encoder, point_decoder, type CardinalDirections, cardinal_directions_encoder, cardinal_directions_decoder, type ImportantData, important_data_encoder, important_data_decoder} - - -pub type ComplicatedData { - ComplicatedData( - big_tuple: #(Option(String), List(Point), Dict(String, Float), Point, ImportantData), - directions: CardinalDirections, - is_true: Bool - ) -} - - -pub fn complicated_data_encoder(complicated_data: ComplicatedData) -> Json { - json.object([ - #("big_tuple", fn(t){let #(a,b,c,d,e) = t json.object([#("first", fn(n){json.nullable(n, json.string)}(a)), #("second", fn(l){json.array(l, point_encoder)}(b)), #("third", fn(d){json.object(dict.map_values(d, fn(_,v){json.float(v)}) |> dict.to_list)}(c)), #("fourth", point_encoder(d)), #("fifth", important_data_encoder(e))])}(complicated_data.big_tuple)), - #("directions", cardinal_directions_encoder(complicated_data.directions)), - #("is_true", json.bool(complicated_data.is_true)) - ]) -} - - -pub fn complicated_data_decoder(json: Dynamic) -> Result(ComplicatedData, List(DecodeError)) { - use big_tuple <- try(dynamic.field("big_tuple", fn(t5json){use a <- try(dynamic.field("first", dynamic.optional(dynamic.string))(t5json)) use b <- try(dynamic.field("second", dynamic.list(point_decoder))(t5json)) use c <- try(dynamic.field("third", dynamic.dict(dynamic.string, dynamic.float))(t5json)) use d <- try(dynamic.field("fourth", point_decoder)(t5json)) use e <- try(dynamic.field("fifth", important_data_decoder)(t5json)) Ok(#(a, b, c, d, e))})(json)) - use directions <- try(dynamic.field("directions", cardinal_directions_decoder)(json)) - use is_true <- try(dynamic.field("is_true", dynamic.bool)(json)) - Ok(ComplicatedData(big_tuple, directions, is_true)) -} - - -/// Temporarily a function solely because Dict's cant be constructed free-hand. -pub fn test_dict() -> Dict(String, String) {dict.from_list([#("Key1", "Val1"), #("Key2", "Val2"), #("Key3", "Val3"), #("Key4", "Val4")])} \ No newline at end of file diff --git a/exampleProject/src/dtt/test_file.gleam b/exampleProject/src/dtt/test_file.gleam deleted file mode 100644 index 9d23cb0..0000000 --- a/exampleProject/src/dtt/test_file.gleam +++ /dev/null @@ -1,89 +0,0 @@ -//// This file was generated by DataTypeTool - -import gleam/dict.{type Dict} -import gleam/set.{type Set} -import gleam/dynamic.{type Dynamic, type DecodeError} -import gleam/json.{type Json} -import gleam/option.{type Option} -import gleam/result.{try} - - -pub type Address { - Address( - street: String, - city: String, - postal_code: String - ) -} - - -pub fn address_encoder(address: Address) -> Json { - json.object([ - #("street", json.string(address.street)), - #("city", json.string(address.city)), - #("postal_code", json.string(address.postal_code)) - ]) -} - - -pub fn address_decoder(json: Dynamic) -> Result(Address, List(DecodeError)) { - use street <- try(dynamic.field("street", dynamic.string)(json)) - use city <- try(dynamic.field("city", dynamic.string)(json)) - use postal_code <- try(dynamic.field("postal_code", dynamic.string)(json)) - Ok(Address(street, city, postal_code)) -} - - -/// Run tests with test.json. -/// I got the json from here: https://www.coderstool.com/json-test-data-generator -pub type TestData { - TestData( - uid: String, - name: String, - dob: String, - address: Address, - telephone: String, - pets: List(String), - score: Float, - email: String, - url: String, - description: String, - verified: Bool, - salary: Int - ) -} - - -pub fn test_data_encoder(test_data: TestData) -> Json { - json.object([ - #("uid", json.string(test_data.uid)), - #("name", json.string(test_data.name)), - #("dob", json.string(test_data.dob)), - #("address", address_encoder(test_data.address)), - #("telephone", json.string(test_data.telephone)), - #("pets", fn(l){json.array(l, json.string)}(test_data.pets)), - #("score", json.float(test_data.score)), - #("email", json.string(test_data.email)), - #("url", json.string(test_data.url)), - #("description", json.string(test_data.description)), - #("verified", json.bool(test_data.verified)), - #("salary", json.int(test_data.salary)) - ]) -} - - -pub fn test_data_decoder(json: Dynamic) -> Result(TestData, List(DecodeError)) { - use uid <- try(dynamic.field("uid", dynamic.string)(json)) - use name <- try(dynamic.field("name", dynamic.string)(json)) - use dob <- try(dynamic.field("dob", dynamic.string)(json)) - use address <- try(dynamic.field("address", address_decoder)(json)) - use telephone <- try(dynamic.field("telephone", dynamic.string)(json)) - use pets <- try(dynamic.field("pets", dynamic.list(dynamic.string))(json)) - use score <- try(dynamic.field("score", dynamic.float)(json)) - use email <- try(dynamic.field("email", dynamic.string)(json)) - use url <- try(dynamic.field("url", dynamic.string)(json)) - use description <- try(dynamic.field("description", dynamic.string)(json)) - use verified <- try(dynamic.field("verified", dynamic.bool)(json)) - use salary <- try(dynamic.field("salary", dynamic.int)(json)) - Ok(TestData(uid, name, dob, address, telephone, pets, score, email, url, description, verified, salary)) -} \ No newline at end of file diff --git a/exampleProject/src/test_project.gleam b/exampleProject/src/test_project.gleam deleted file mode 100644 index 8fe3ade..0000000 --- a/exampleProject/src/test_project.gleam +++ /dev/null @@ -1,31 +0,0 @@ -import gleam/io -import gleam/function -import gleam/set.{type Set} -import gleam/dynamic.{type Dynamic} -import gleam/result.{try, map} -import gleam/json.{type Json} -import dtt/test_file - -pub fn main() { - let assert Ok(this_json) = - test_json - |> json.decode(dynamic.dynamic) - io.debug(this_json) - io.println(" ") - - let assert Ok(data) = test_file.test_data_decoder(this_json) - io.debug(data) - io.println(" ") - - let new_json = test_file.test_data_encoder(data) - io.debug(json.to_string(new_json)) - io.println(" ") - - let assert Ok(new_dyn) = json.decode(json.to_string(new_json), dynamic.dynamic) - io.debug(new_dyn) - io.println(" ") - - io.debug(this_json == new_dyn) -} - -const test_json = "{\"uid\": \"1NZR6G48Q7086GKV\", \"name\": \"Sylvia Valenti\", \"dob\": \"2015-12-02\", \"address\": { \"street\": \"9176 Wincombe Street\", \"city\": \"Uppingham\", \"postal_code\": \"SY5 7PF\" }, \"telephone\": \"+53-4720-814-866\", \"pets\": [ \"Blackie\", \"Riley\" ], \"score\": 5.5, \"email\": \"sade6144@freeze.nh.us\", \"url\": \"http://portable.trentinosud-tirol.it\", \"description\": \"cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian\", \"verified\": true, \"salary\": 67737}" \ No newline at end of file diff --git a/exampleProject/test.json b/exampleProject/test.json deleted file mode 100644 index 097dd24..0000000 --- a/exampleProject/test.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "uid": "1NZR6G48Q7086GKV", - "name": "Sylvia Valenti", - "dob": "2015-12-02", - "address": { - "street": "9176 Wincombe Street", - "city": "Uppingham", - "postal_code": "SY5 7PF" - }, - "telephone": "+53-4720-814-866", - "pets": [ - "Blackie", - "Riley" - ], - "score": 5.5, - "email": "sade6144@freeze.nh.us", - "url": "http://portable.trentinosud-tirol.it", - "description": "cooler propecia modification vice alternative those drove rapidly warren rd solutions media person dale idol permitted hacker hats greatest debian", - "verified": true, - "salary": 67737 -} \ No newline at end of file diff --git a/exampleProject/types/Basic_Test.type b/exampleProject/types/Basic_Test.type deleted file mode 100644 index a23597a..0000000 --- a/exampleProject/types/Basic_Test.type +++ /dev/null @@ -1,40 +0,0 @@ -alias Point: - meta: - lang: - elm - doc: - This is a basic Point type. - All of this is a docstring. - type: - Tuple2 Float Float - -enum Cardinal_Directions: - meta: - lang: - haskell - members: - North - South - East - West - -model Important_Data: - meta: - ref: - Folder/Another_Test:A_B_C - fields: - field This: - type: - Str - field That: - type: - Nullable Int - field Something: - type: - A_B_C - -constant Life: - type: - Int - value: - 42 \ No newline at end of file diff --git a/exampleProject/types/Example.type b/exampleProject/types/Example.type new file mode 100644 index 0000000..d8e25cc --- /dev/null +++ b/exampleProject/types/Example.type @@ -0,0 +1,22 @@ +# A wiki to get you started:# TODO: Add wiki +model People: + fields: + field First_Name: + type: + Str + field Last_Name: + type: + Str + field Age: + type: + Int + +enum Answers: + members: + Yes + No + Unsure + +alias Point: + type: + Tuple2 Float Float diff --git a/exampleProject/types/Folder/Another_Test.type b/exampleProject/types/Folder/Another_Test.type deleted file mode 100644 index d22ef98..0000000 --- a/exampleProject/types/Folder/Another_Test.type +++ /dev/null @@ -1,14 +0,0 @@ -enum A_B_C: - members: - A - B - C - -constant This_Repo: - meta: - doc: - This is where to find DataTypeTool - type: - Str - value: - "https://codeberg.org/dneaves/datatypetool" diff --git a/exampleProject/types/Folder/Complex_Tests.type b/exampleProject/types/Folder/Complex_Tests.type deleted file mode 100644 index 196437b..0000000 --- a/exampleProject/types/Folder/Complex_Tests.type +++ /dev/null @@ -1,20 +0,0 @@ -model Complicated_Data: - meta: - ref: - Basic_Test:Point:Cardinal_Directions:Important_Data - fields: - field Big_Tuple: - type: - Tuple5 (Nullable Str) (List Point) (Dict Float) (Point) (Important_Data) - field Directions: - type: - Cardinal_Directions - field Is_True: - type: - Bool - -constant Test_Dict: - type: - Dict Str - value: - Dict [{"Key1", "Val1"}, {"Key2", "Val2"}, {"Key3", "Val3"}, {"Key4", "Val4"}] \ No newline at end of file diff --git a/exampleProject/types/Test_File.type b/exampleProject/types/Test_File.type deleted file mode 100644 index b0ad971..0000000 --- a/exampleProject/types/Test_File.type +++ /dev/null @@ -1,54 +0,0 @@ -model Address: - fields: - field Street: - type: - Str - field City: - type: - Str - field Postal_Code: - type: - Str - -model Test_Data: - meta: - doc: - Run tests with test.json. - I got the json from here: https://www.coderstool.com/json-test-data-generator - fields: - field Uid: - type: - Str - field Name: - type: - Str - field Dob: - type: - Str - field Address: - type: - Address - field Telephone: - type: - Str - field Pets: - type: - List Str - field Score: - type: - Float - field Email: - type: - Str - field Url: - type: - Str - field Description: - type: - Str - field Verified: - type: - Bool - field Salary: - type: - Int \ No newline at end of file diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..fcc5c99 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,67 @@ +# Number of spaces per indentation step +indentation: 4 + +# Max line length for automatic line breaking +column-limit: none + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: leading + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +# Doesn't matter since stylish-haskell runs after this +import-export-style: diff-friendly + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: false + +# Whether to leave a space before an opening record brace +record-brace-space: false + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: multi-line + +# How to print module docstring +haddock-style-module: null + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: inline + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: left-align + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: always + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: + - infixl 9 <. + - infixr 9 .> + - infixr 8 ^, ^^, ** + - infixl 7 *, / + - infixl 6 +, - + - infixr 6 <> + - infixr 5 ++, :| + - infixl 4 <$, $>, <$>, <*>, <*, *>, <**> + - infix 4 ==, /=, <, <=, >, >= + - infixl 3 <|> + - infixr 3 && + - infixr 2 || + - infixl 1 >>, >>=, <<, <&> + - infixr 1 =<<, <=<, >=> + - infixr 0 <|, $! + - infixl 0 |> + +# Module reexports Fourmolu should know about +reexports: [] diff --git a/justfile b/justfile index 6fb7726..3648fda 100644 --- a/justfile +++ b/justfile @@ -10,8 +10,9 @@ app_version := `sed -n 's/^version: *\(.*\)/\1/p' ./datatypetool.cabal` # Format all the things @format: - stylish-haskell --inplace -r app/*.hs - cabal-fmt --inplace --indent 2 ./datatypetool.cabal + fourmolu -i {{ justfile_directory() }}/. && \ + stylish-haskell -ir {{ justfile_directory() }} && \ + cabal-fmt -i {{ justfile_directory() }}/datatypetool.cabal && \ nixfmt shell.nix nix/* # Experimental @@ -23,4 +24,4 @@ app_version := `sed -n 's/^version: *\(.*\)/\1/p' ./datatypetool.cabal` # Build, then run from the heavily-nested dist directory. This command breaks if the version changes, so change this command appropriately. # @build_and_run *args: -# cabal build && ./dist-newstyle/build/x86_64-linux/ghc-9.8.2/datatypetool-0.1.0.0/x/datatypetool/build/datatypetool/datatypetool \ No newline at end of file +# cabal build && ./dist-newstyle/build/x86_64-linux/ghc-9.8.2/datatypetool-0.1.0.0/x/datatypetool/build/datatypetool/datatypetool -- knotmirror 0.0.1