SamuelSchlesinger/hs-ts
1
1
Fork 0
mirror of https://github.com/SamuelSchlesinger/hs-ts.git synced 2024-09-11 10:55:41 +03:00
Code Issues Projects Releases Wiki Activity

First Commit

Browse Source
This commit is contained in:
Samuel Schlesinger 2021-08-24 17:38:04 -04:00
commit 426dc6e514
31 changed files with 12373 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
dist-newstyle/
node_modules/
build/

5
CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for hs-ts
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

6
app/Main.hs Normal file
View File

@ -0,0 +1,6 @@
module Main where
import qualified DevTool
main :: IO ()
main = DevTool.main

23
frontend/.gitignore vendored Normal file
View File

@ -0,0 +1,23 @@
# See https://help.github.com/articles/ignoring-files/ for more about ignoring files.
# dependencies
/node_modules
/.pnp
.pnp.js
# testing
/coverage
# production
/build
# misc
.DS_Store
.env.local
.env.development.local
.env.test.local
.env.production.local
npm-debug.log*
yarn-debug.log*
yarn-error.log*

46
frontend/README.md Normal file
View File

@ -0,0 +1,46 @@
# Getting Started with Create React App
This project was bootstrapped with [Create React App](https://github.com/facebook/create-react-app).
## Available Scripts
In the project directory, you can run:
### `yarn start`
Runs the app in the development mode.\
Open [http://localhost:3000](http://localhost:3000) to view it in the browser.
The page will reload if you make edits.\
You will also see any lint errors in the console.
### `yarn test`
Launches the test runner in the interactive watch mode.\
See the section about [running tests](https://facebook.github.io/create-react-app/docs/running-tests) for more information.
### `yarn build`
Builds the app for production to the `build` folder.\
It correctly bundles React in production mode and optimizes the build for the best performance.
The build is minified and the filenames include the hashes.\
Your app is ready to be deployed!
See the section about [deployment](https://facebook.github.io/create-react-app/docs/deployment) for more information.
### `yarn eject`
**Note: this is a one-way operation. Once you `eject`, you can’t go back!**
If you aren’t satisfied with the build tool and configuration choices, you can `eject` at any time. This command will remove the single build dependency from your project.
Instead, it will copy all the configuration files and the transitive dependencies (webpack, Babel, ESLint, etc) right into your project so you have full control over them. All of the commands except `eject` will still work, but they will point to the copied scripts so you can tweak them. At this point you’re on your own.
You don’t have to ever use `eject`. The curated feature set is suitable for small and middle deployments, and you shouldn’t feel obligated to use this feature. However we understand that this tool wouldn’t be useful if you couldn’t customize it when you are ready for it.
## Learn More
You can learn more in the [Create React App documentation](https://facebook.github.io/create-react-app/docs/getting-started).
To learn React, check out the [React documentation](https://reactjs.org/).

45
frontend/package.json Normal file
View File

@ -0,0 +1,45 @@
{
"name": "frontend",
"version": "0.1.0",
"private": true,
"dependencies": {
"@testing-library/jest-dom": "^5.11.4",
"@testing-library/react": "^11.1.0",
"@testing-library/user-event": "^12.1.10",
"@types/jest": "^26.0.15",
"@types/node": "^12.0.0",
"@types/react": "^17.0.0",
"@types/react-dom": "^17.0.0",
"@types/styled-components": "^5.1.12",
"react": "^17.0.2",
"react-dom": "^17.0.2",
"react-scripts": "4.0.3",
"styled-components": "^5.3.1",
"typescript": "^4.1.2",
"web-vitals": "^1.0.1"
},
"scripts": {
"start": "react-scripts start",
"build": "react-scripts build",
"test": "react-scripts test",
"eject": "react-scripts eject"
},
"eslintConfig": {
"extends": [
"react-app",
"react-app/jest"
]
},
"browserslist": {
"production": [
">0.2%",
"not dead",
"not op_mini all"
],
"development": [
"last 1 chrome version",
"last 1 firefox version",
"last 1 safari version"
]
}
}

BIN
frontend/public/favicon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.8 KiB

43
frontend/public/index.html Normal file
View File

@ -0,0 +1,43 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8" />
<link rel="icon" href="%PUBLIC_URL%/favicon.ico" />
<meta name="viewport" content="width=device-width, initial-scale=1" />
<meta name="theme-color" content="#000000" />
<meta
name="description"
content="Web site created using create-react-app"
/>
<link rel="apple-touch-icon" href="%PUBLIC_URL%/logo192.png" />
<!--
manifest.json provides metadata used when your web app is installed on a
user's mobile device or desktop. See https://developers.google.com/web/fundamentals/web-app-manifest/
-->
<link rel="manifest" href="%PUBLIC_URL%/manifest.json" />
<!--
Notice the use of %PUBLIC_URL% in the tags above.
It will be replaced with the URL of the `public` folder during the build.
Only files inside the `public` folder can be referenced from the HTML.
Unlike "/favicon.ico" or "favicon.ico", "%PUBLIC_URL%/favicon.ico" will
work correctly both with client-side routing and a non-root public URL.
Learn how to configure a non-root public URL by running `npm run build`.
-->
<title>React App</title>
</head>
<body>
<noscript>You need to enable JavaScript to run this app.</noscript>
<div id="root"></div>
<!--
This HTML file is a template.
If you open it directly in the browser, you will see an empty page.
You can add webfonts, meta tags, or analytics to this file.
The build step will place the bundled scripts into the <body> tag.
To begin the development, run `npm start` or `yarn start`.
To create a production bundle, use `npm run build` or `yarn build`.
-->
</body>
</html>

BIN
frontend/public/logo192.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.2 KiB

BIN
frontend/public/logo512.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 9.4 KiB

25
frontend/public/manifest.json Normal file
View File

@ -0,0 +1,25 @@
{
"short_name": "React App",
"name": "Create React App Sample",
"icons": [
{
"src": "favicon.ico",
"sizes": "64x64 32x32 24x24 16x16",
"type": "image/x-icon"
},
{
"src": "logo192.png",
"type": "image/png",
"sizes": "192x192"
},
{
"src": "logo512.png",
"type": "image/png",
"sizes": "512x512"
}
],
"start_url": ".",
"display": "standalone",
"theme_color": "#000000",
"background_color": "#ffffff"
}

3
frontend/public/robots.txt Normal file
View File

@ -0,0 +1,3 @@
# https://www.robotstxt.org/robotstxt.html
User-agent: *
Disallow:

11
frontend/src/Api.ts Normal file
View File

@ -0,0 +1,11 @@
export interface IExampleRequest {
someField: string;
}
export interface IExampleResponse {
anotherField: string;
}
export type ExampleRequest = IExampleRequest;
export type ExampleResponse = IExampleResponse;

3
frontend/src/App.css Normal file
View File

@ -0,0 +1,3 @@
.App {
text-align: center;
}

9
frontend/src/App.test.tsx Normal file
View File

@ -0,0 +1,9 @@
import React from 'react';
import { render, screen } from '@testing-library/react';
import App from './App';
test('renders learn react link', () => {
render(<App />);
const linkElement = screen.getByText(/learn react/i);
expect(linkElement).toBeInTheDocument();
});

64
frontend/src/App.tsx Normal file
View File

@ -0,0 +1,64 @@
import React from 'react';
import './App.css';
import { ExampleRequest, ExampleResponse } from './Api.js';
import styled from 'styled-components';
function exampleEndpoint(exampleRequest: ExampleRequest): Promise<ExampleResponse> {
return fetch('http://localhost:3001/example',
{ method: 'POST'
, mode: 'cors'
, cache: 'no-cache'
, credentials: 'omit'
, headers: {
'Content-Type': 'application/json'
}
, redirect: 'follow'
, referrerPolicy: 'no-referrer'
, body: JSON.stringify(exampleRequest)
}
).then((r) => r.json())
}
const AppContainer = styled.div`
text-align: center;
`
function ifThenElse<X>(b:boolean, x:X, y:X): X {
if (b) {
return x;
} else {
return y;
}}
function ExampleForm(props: { input: string, output: string | null, onInputChange: (e:React.ChangeEvent<HTMLInputElement>) => void }) {
return (
<form >
<input type="string" onChange={props.onInputChange} value={props.input}/>
<p> Amazing output: { props.output } </p>
</form>
)
}
function App() {
const [input, setInput] = React.useState("");
const [output, setOutput] = React.useState<string>("")
React.useEffect(() =>
{ const setEm = async () =>
{ const x = await exampleEndpoint({someField: input});
setOutput((_o) => x.anotherField);
}
setEm();
}
, [input]);
const onInputChange = (e: React.ChangeEvent<HTMLInputElement>) => {
setInput((_i) => e.target.value);
};
return (
<AppContainer className="App">
<h1> Haskell + TypeScript Example </h1>
<ExampleForm input={input} output={output} onInputChange={onInputChange}/>
</AppContainer>
);
}
export default App;

13
frontend/src/index.css Normal file
View File

@ -0,0 +1,13 @@
body {
margin: 0;
font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', 'Roboto', 'Oxygen',
'Ubuntu', 'Cantarell', 'Fira Sans', 'Droid Sans', 'Helvetica Neue',
sans-serif;
-webkit-font-smoothing: antialiased;
-moz-osx-font-smoothing: grayscale;
}
code {
font-family: source-code-pro, Menlo, Monaco, Consolas, 'Courier New',
monospace;
}

17
frontend/src/index.tsx Normal file
View File

@ -0,0 +1,17 @@
import React from 'react';
import ReactDOM from 'react-dom';
import './index.css';
import App from './App';
import reportWebVitals from './reportWebVitals';
ReactDOM.render(
<React.StrictMode>
<App />
</React.StrictMode>,
document.getElementById('root')
);
// If you want to start measuring performance in your app, pass a function
// to log results (for example: reportWebVitals(console.log))
// or send to an analytics endpoint. Learn more: https://bit.ly/CRA-vitals
reportWebVitals();

1
frontend/src/react-app-env.d.ts vendored Normal file
View File

@ -0,0 +1 @@
/// <reference types="react-scripts" />

15
frontend/src/reportWebVitals.ts Normal file
View File

@ -0,0 +1,15 @@
import { ReportHandler } from 'web-vitals';
const reportWebVitals = (onPerfEntry?: ReportHandler) => {
if (onPerfEntry && onPerfEntry instanceof Function) {
import('web-vitals').then(({ getCLS, getFID, getFCP, getLCP, getTTFB }) => {
getCLS(onPerfEntry);
getFID(onPerfEntry);
getFCP(onPerfEntry);
getLCP(onPerfEntry);
getTTFB(onPerfEntry);
});
}
};
export default reportWebVitals;

5
frontend/src/setupTests.ts Normal file
View File

@ -0,0 +1,5 @@
// jest-dom adds custom jest matchers for asserting on DOM nodes.
// allows you to do things like:
// expect(element).toHaveTextContent(/react/i)
// learn more: https://github.com/testing-library/jest-dom
import '@testing-library/jest-dom';

26
frontend/tsconfig.json Normal file
View File

@ -0,0 +1,26 @@
{
"compilerOptions": {
"target": "es5",
"lib": [
"dom",
"dom.iterable",
"esnext"
],
"allowJs": true,
"skipLibCheck": true,
"esModuleInterop": true,
"allowSyntheticDefaultImports": true,
"strict": true,
"forceConsistentCasingInFileNames": true,
"noFallthroughCasesInSwitch": true,
"module": "esnext",
"moduleResolution": "node",
"resolveJsonModule": true,
"isolatedModules": true,
"noEmit": true,
"jsx": "react-jsx"
},
"include": [
"src"
]
}

11714
frontend/yarn.lock Normal file
View File

File diff suppressed because it is too large Load Diff

36
hs-ts.cabal Normal file
View File

@ -0,0 +1,36 @@
cabal-version: 2.4
name: hs-ts
version: 0.1.0.0
author: Samuel Schlesinger
maintainer: samuel@simspace.com
extra-source-files: CHANGELOG.md
library
exposed-modules: DevTool, Web.API, Web.Server, DevTool.Interface, Web.Json
build-depends:
base >=4.4 && <5,
wai >=3.2 && <4,
warp >=3.3 && <4,
aeson >=1.5 && <2,
aeson-typescript >=0.3 && <1,
wai-cors >=0.2 && <1,
servant >=0.18 && <0.19,
servant-server >=0.18 && <0.19,
sop-core >=0.5 && <1,
optparse-applicative >=0.16 && <1,
directory >=1.3 && <2,
bytestring >=0.10 && <1,
containers >=0.6 && <1,
time >=1.9 && <2,
text >=1.2 && <2,
http-media >=0.8 && <0.9,
wai-extra >=3.1 && <4
hs-source-dirs: src
ghc-options: -Wall -Werror
default-language: Haskell2010
executable devtool
main-is: Main.hs
build-depends: base ^>=4.14.2.0, hs-ts
hs-source-dirs: app
default-language: Haskell2010

11
install.sh Normal file
View File

@ -0,0 +1,11 @@
cabal install --overwrite-policy=always
echo "Built + Installed Haskell artifacts"
devtool typescript > frontend/src/Api.ts
echo "Generated up to date TypeScript types"
cd frontend
yarn build
echo "Transpiled and optimized the frontend artifacts"
mkdir -p $HOME/.devtool
echo "Ensured the existence the $HOME/.devtool directory"
cp -R build $HOME/.devtool
echo "Copied the frontend artifacts to the $HOME/.devtool directory"

51
src/DevTool.hs Normal file
View File

@ -0,0 +1,51 @@
module DevTool where
import DevTool.Interface (Command(..), runCommand)
import Options.Applicative
main :: IO ()
main = customExecParser ps parser >>= runCommand
where
ps = prefs . mconcat $
[ disambiguate
, showHelpOnError
, showHelpOnEmpty
, columns 80
]
author :: String
author = "TODO: Replace with your name"
projectName :: String
projectName = "TODO: Replace with your project name"
currentYear :: String
currentYear = "TODO: Replace with current year"
parser :: ParserInfo Command
parser = flip info mods . hsubparser . mconcat $
[ command "typescript" (info parseTypeScript (progDesc "Generate the typescript for the API"))
, command "serve" (info parseServer (progDesc "Run the server"))
]
where
mods
= header projectName
<> footer
( "Copyright "
<> currentYear
<> " (c) "
<> author
)
<> progDesc "Development Tools"
parseTypeScript
= pure TypeScript
parseServer
= Serve <$> portOption
portOption
= option auto
( long "port"
<> short 'p'
<> metavar "PORT"
<> value 3001
<> help "The port to run the server on"
)

37
src/DevTool/Interface.hs Normal file
View File

@ -0,0 +1,37 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module DevTool.Interface
( runCommand
, Command(..)
) where
import Web.API (renderedTypeScriptTypes, api)
import Web.Server (server)
import qualified Servant (serve)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Middleware.Autohead (autohead)
import Network.Wai.Middleware.Cors (cors, simpleCorsResourcePolicy, CorsResourcePolicy(..))
import System.Directory (getHomeDirectory, setCurrentDirectory)
data Command =
TypeScript
| Serve Int
runCommand :: Command -> IO ()
runCommand = \case
TypeScript -> typescript
Serve n -> serve n
typescript :: IO ()
typescript = putStrLn renderedTypeScriptTypes
serve :: Int -> IO ()
serve n = do
getHomeDirectory >>= setCurrentDirectory . (<> "/.devtool")
run n . middleware $ Servant.serve api server
where
middleware =
logStdoutDev
. autohead
. cors ( const $ Just (simpleCorsResourcePolicy { corsRequestHeaders = ["Content-Type"] }) )

BIN
src/Web/.API.hs.swp Normal file
View File

Binary file not shown.

107
src/Web/API.hs Normal file
View File

@ -0,0 +1,107 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Web.API
( API
, renderedTypeScriptTypes
, typeScriptTypes
, api
, ExampleRequest(..)
, ExampleResponse(..)
) where
import Servant.API
import GHC.TypeLits (Symbol)
import Web.Json
import GHC.Generics (Generic)
import Data.Aeson (ToJSON, FromJSON)
import Data.Proxy (Proxy(Proxy))
import Data.Aeson.TypeScript.TH (deriveTypeScript, TSDeclaration, formatTSDeclarations', FormattingOptions(..), ExportMode(ExportEach), SumTypeFormat(EnumWithType))
import Data.Aeson.TypeScript.Recursive (getTypeScriptDeclarationsRecursively)
import Network.HTTP.Media.MediaType ((//))
renderedTypeScriptTypes :: String
renderedTypeScriptTypes = formatTSDeclarations' typeScriptFormattingOptions typeScriptTypes where
typeScriptFormattingOptions = FormattingOptions
{ numIndentSpaces = 2
, interfaceNameModifier = id
, typeNameModifier = id
, exportMode = ExportEach
, typeAlternativesFormat = EnumWithType
}
typeScriptTypes :: [TSDeclaration]
typeScriptTypes = getTypeScriptDeclarationsRecursively (Proxy @(TypeScriptTypes API))
api :: Proxy API
api = Proxy
type family TypeScriptTypes xs where
TypeScriptTypes EmptyAPI
= ()
TypeScriptTypes (NoContentVerb (method :: k))
= ()
TypeScriptTypes ((x :: Symbol) :> y)
= TypeScriptTypes y
TypeScriptTypes (ReqBody' mods contentTypes x :> y)
= ( If (ContainsJSON contentTypes) x ()
, TypeScriptTypes y
)
TypeScriptTypes (xs :<|> ys)
= ( TypeScriptTypes xs
, TypeScriptTypes ys
)
TypeScriptTypes (UVerb method contentTypes returnTypes)
= If (ContainsJSON contentTypes) (UVerbTypeScript returnTypes) ()
TypeScriptTypes (Verb method status contentTypes returnType)
= If (ContainsJSON contentTypes) returnType ()
TypeScriptTypes Raw
= ()
type family UVerbTypeScript xs where
UVerbTypeScript (WithStatus n x ': xs) = (x, UVerbTypeScript xs)
UVerbTypeScript (x ': xs) = (x, UVerbTypeScript xs)
type family ContainsJSON xs where
ContainsJSON '[] = 'False
ContainsJSON (JSON ': xs) = 'True
ContainsJSON (x ': xs) = ContainsJSON xs
data AllTypes
instance Accept AllTypes where
contentType _ = "*" // "*"
instance MimeRender AllTypes () where
mimeRender _ _ = ""
data ExampleRequest = ExampleRequest
{ someField :: String
}
deriving stock (Eq, Ord, Show, Read, Generic)
deriving (ToJSON, FromJSON) via Json ExampleRequest
data ExampleResponse = ExampleResponse
{ anotherField :: String
}
deriving stock (Eq, Ord, Show, Read, Generic)
deriving (ToJSON, FromJSON) via Json ExampleResponse
type API =
"health" :> GetNoContent
:<|> "example" :> ReqBody '[JSON] ExampleRequest :> Post '[JSON] ExampleResponse
:<|> UVerb 'GET '[AllTypes] '[WithStatus 302 (Headers '[Header "Location" String] ())]
:<|> Raw
$(deriveTypeScript aesonOptions ''ExampleRequest)
$(deriveTypeScript aesonOptions ''ExampleResponse)

19
src/Web/Json.hs Normal file
View File

@ -0,0 +1,19 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Web.Json where
import GHC.Generics (Generic, Rep)
import qualified Data.Aeson as Aeson
import Data.Aeson (ToJSON, FromJSON)
newtype Json a = Json { unJson :: a }
instance (Generic a, Aeson.GToJSON' Aeson.Encoding Aeson.Zero (Rep a), Aeson.GToJSON' Aeson.Value Aeson.Zero (Rep a)) => ToJSON (Json a) where
toEncoding = Aeson.genericToEncoding aesonOptions . unJson
toJSON = Aeson.genericToJSON aesonOptions . unJson
instance (Generic a, Aeson.GFromJSON Aeson.Zero (Rep a)) => FromJSON (Json a) where
parseJSON val = Json <$> Aeson.genericParseJSON aesonOptions val
aesonOptions :: Aeson.Options
aesonOptions = Aeson.defaultOptions

35
src/Web/Server.hs Normal file
View File

@ -0,0 +1,35 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
module Web.Server where
import Web.API
import Servant
import Data.SOP.BasicFunctors (I(..))
server :: Server API
server
= health
:<|> example
:<|> redirect
:<|> fileServer
health :: Handler NoContent
health =
pure NoContent
type RedirectResponse = WithStatus 302 (Headers '[Header "Location" String] ())
redirect :: Handler (Union '[RedirectResponse])
redirect
= pure
( inject @(WithStatus 302 (Headers '[Header "Location" String] ()))
(I (WithStatus (addHeader "/index.html" ())))
)
fileServer :: Server Raw
fileServer = serveDirectoryWebApp "."
example :: ExampleRequest -> Handler ExampleResponse
example exampleRequest = pure $ ExampleResponse
{ anotherField = someField exampleRequest <> "!!!"
}