Compare commits
6
Commits
7a91c520ee
...
0.6
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
77887bb29e | ||
|
|
7c4fea02d1 | ||
|
|
e344ddefb5 | ||
|
|
2024e230a8 | ||
|
|
ce75f2ae7d | ||
|
|
18946f2d57 |
+41
-4
@@ -24,6 +24,7 @@ import Network.Wai (Application)
|
|||||||
import Servant
|
import Servant
|
||||||
( Accept (..)
|
( Accept (..)
|
||||||
, Handler
|
, Handler
|
||||||
|
, Header
|
||||||
, MimeRender (..)
|
, MimeRender (..)
|
||||||
, Server
|
, Server
|
||||||
, ServerError (..)
|
, ServerError (..)
|
||||||
@@ -61,14 +62,18 @@ app :: Application
|
|||||||
app = serve (Proxy :: Proxy API) server
|
app = serve (Proxy :: Proxy API) server
|
||||||
|
|
||||||
type API =
|
type API =
|
||||||
"utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model
|
Header "Host" Text :> Get '[PlainText, HTML] RootModel
|
||||||
|
:<|> "utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model
|
||||||
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
|
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
|
||||||
:<|> "text" :> Capture "text" Text :> Get '[PlainText, HTML] TextModel
|
:<|> "text" :> Capture "text" Text :> Get '[PlainText, HTML] TextModel
|
||||||
|
|
||||||
server :: Server API
|
server :: Server API
|
||||||
server =
|
server =
|
||||||
utf8R :<|> codepointsR :<|> textR
|
rootR :<|> utf8R :<|> codepointsR :<|> textR
|
||||||
where
|
where
|
||||||
|
rootR host = do
|
||||||
|
pure $ RootModel $ fromMaybe "" host
|
||||||
|
|
||||||
utf8R bytesP = do
|
utf8R bytesP = do
|
||||||
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
|
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
|
||||||
pure $ mkUtf8Model bytes
|
pure $ mkUtf8Model bytes
|
||||||
@@ -80,6 +85,38 @@ server =
|
|||||||
textR textP = do
|
textR textP = do
|
||||||
pure $ TextModel textP
|
pure $ TextModel textP
|
||||||
|
|
||||||
|
-- /
|
||||||
|
|
||||||
|
newtype RootModel = RootModel
|
||||||
|
{ host :: Text
|
||||||
|
}
|
||||||
|
|
||||||
|
examples :: [Text]
|
||||||
|
examples =
|
||||||
|
[ "/text/✅🤔"
|
||||||
|
, "/codepoints/x2705+x1F914"
|
||||||
|
, "/utf8/e2.9c.85.f0.9f.a4.94"
|
||||||
|
]
|
||||||
|
|
||||||
|
instance MimeRender PlainText RootModel where
|
||||||
|
mimeRender _ model = renderText $ Text.unlines $
|
||||||
|
[ "⚞ utoy ⚟"
|
||||||
|
, ""
|
||||||
|
, "This is utoy, a URL-based Unicode playground. Examples:"
|
||||||
|
, ""
|
||||||
|
] ++ map (urlBase <>) examples
|
||||||
|
where
|
||||||
|
-- We assume HTTPS here. Doesn't work for development on localhost.
|
||||||
|
urlBase = "https://" <> model.host
|
||||||
|
|
||||||
|
instance MimeRender HTML RootModel where
|
||||||
|
mimeRender _ model = renderHtml $ documentWithBody $ do
|
||||||
|
H.h1 $ H.toHtml ("⚞ utoy ⚟" :: Text)
|
||||||
|
H.p $ H.toHtml ("This is utoy, a URL-based Unicode playground. Examples:" :: Text)
|
||||||
|
H.ul $ for_ examples $ \example -> do
|
||||||
|
let url = "https://" <> model.host <> example
|
||||||
|
H.li $ H.a ! A.href (H.toValue url) $ H.toHtml example
|
||||||
|
|
||||||
-- /bytes/<bytes>
|
-- /bytes/<bytes>
|
||||||
|
|
||||||
newtype Utf8Model = Utf8Model
|
newtype Utf8Model = Utf8Model
|
||||||
@@ -197,7 +234,7 @@ instance MimeRender HTML TextModel where
|
|||||||
|
|
||||||
instance MimeRender PlainText TextModel where
|
instance MimeRender PlainText TextModel where
|
||||||
mimeRender _ model = renderText $ Table.render " "
|
mimeRender _ model = renderText $ Table.render " "
|
||||||
[ map (Table.cl)
|
[ map Table.cl
|
||||||
[ Text.pack [c]
|
[ Text.pack [c]
|
||||||
, Text.pack $ printf "U+%04X" c
|
, Text.pack $ printf "U+%04X" c
|
||||||
, Text.pack $ intercalate ", " $ allNames c
|
, Text.pack $ intercalate ", " $ allNames c
|
||||||
@@ -241,7 +278,7 @@ documentWithBody body =
|
|||||||
H.meta ! A.charset "utf-8"
|
H.meta ! A.charset "utf-8"
|
||||||
H.title "utoy"
|
H.title "utoy"
|
||||||
H.style $ H.toHtml $ Encoding.decodeUtf8 $(embedFile "static/utoy.css")
|
H.style $ H.toHtml $ Encoding.decodeUtf8 $(embedFile "static/utoy.css")
|
||||||
H.body body
|
H.body $ H.main body
|
||||||
|
|
||||||
-- HTML routes
|
-- HTML routes
|
||||||
|
|
||||||
|
|||||||
@@ -13,27 +13,37 @@
|
|||||||
haskellPackages = pkgs.haskell.packages."${settings.ghc}";
|
haskellPackages = pkgs.haskell.packages."${settings.ghc}";
|
||||||
|
|
||||||
ghc = haskellPackages.ghcWithPackages haskellDeps;
|
ghc = haskellPackages.ghcWithPackages haskellDeps;
|
||||||
|
|
||||||
|
# Wrap stack to disable its slow Nix integration.
|
||||||
|
# Instead, make it use the GHC defined above.
|
||||||
stack = pkgs.stdenv.mkDerivation {
|
stack = pkgs.stdenv.mkDerivation {
|
||||||
name = "stack";
|
name = "stack";
|
||||||
dontUnpack = true;
|
|
||||||
dontConfigure = true;
|
# The build is simply a call to makeWrapper, so we don't have to
|
||||||
dontBuild = true;
|
# do any of the typical build steps.
|
||||||
|
phases = [ "installPhase" ];
|
||||||
|
|
||||||
nativeBuildInputs = [ pkgs.makeWrapper ];
|
nativeBuildInputs = [ pkgs.makeWrapper ];
|
||||||
|
# makeBinaryWrapper creates a stack executable for us that uses
|
||||||
|
# the GHC defined in this file.
|
||||||
installPhase = ''
|
installPhase = ''
|
||||||
makeWrapper ${pkgs.stack}/bin/stack $out/bin/stack \
|
makeWrapper ${pkgs.stack}/bin/stack $out/bin/stack \
|
||||||
--prefix PATH : ${ghc}/bin \
|
--prefix PATH : ${ghc}/bin \
|
||||||
--add-flags '--no-nix --system-ghc --no-install-ghc'
|
--add-flags '--no-nix --system-ghc --no-install-ghc'
|
||||||
'';
|
'';
|
||||||
};
|
};
|
||||||
utoy' =
|
|
||||||
{ mkDerivation }:
|
utoy = pkgs.haskell.lib.justStaticExecutables (haskellPackages.callPackage
|
||||||
|
({ mkDerivation }:
|
||||||
mkDerivation {
|
mkDerivation {
|
||||||
version = "0.5";
|
# Keep this in sync with package.yaml
|
||||||
|
version = "0.6";
|
||||||
pname = "utoy";
|
pname = "utoy";
|
||||||
license = pkgs.lib.licenses.mit;
|
license = pkgs.lib.licenses.mit;
|
||||||
src =
|
src =
|
||||||
|
# We only need these files for building:
|
||||||
let
|
let
|
||||||
buildFiles = [
|
whitelist = [
|
||||||
./LICENSE
|
./LICENSE
|
||||||
./utoy.cabal
|
./utoy.cabal
|
||||||
./Setup.hs
|
./Setup.hs
|
||||||
@@ -45,17 +55,14 @@
|
|||||||
in
|
in
|
||||||
pkgs.lib.sources.cleanSourceWith {
|
pkgs.lib.sources.cleanSourceWith {
|
||||||
src = ./.;
|
src = ./.;
|
||||||
filter = path: _type: pkgs.lib.any (prefix: pkgs.lib.hasPrefix (toString prefix) path) buildFiles;
|
filter = path: _type: pkgs.lib.any (prefix: pkgs.lib.hasPrefix (toString prefix) path) whitelist;
|
||||||
};
|
};
|
||||||
|
|
||||||
libraryHaskellDepends = haskellDeps haskellPackages;
|
libraryHaskellDepends = haskellDeps haskellPackages;
|
||||||
};
|
}) {});
|
||||||
utoy = pkgs.haskell.lib.justStaticExecutables (haskellPackages.callPackage utoy' {});
|
|
||||||
in {
|
in {
|
||||||
packages.x86_64-linux = {
|
packages.x86_64-linux = {
|
||||||
inherit ghc;
|
inherit ghc;
|
||||||
inherit stack;
|
inherit stack;
|
||||||
inherit utoy;
|
|
||||||
|
|
||||||
docker =
|
docker =
|
||||||
pkgs.dockerTools.buildImage {
|
pkgs.dockerTools.buildImage {
|
||||||
|
|||||||
+1
-1
@@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
name: utoy
|
name: utoy
|
||||||
# Keep this in sync with the version in flake.nix.
|
# Keep this in sync with the version in flake.nix.
|
||||||
version: 0.5
|
version: 0.6
|
||||||
git: "https://git.pbrinkmeier.de/paul/utoy"
|
git: "https://git.pbrinkmeier.de/paul/utoy"
|
||||||
license: MIT
|
license: MIT
|
||||||
author: "Paul Brinkmeier"
|
author: "Paul Brinkmeier"
|
||||||
|
|||||||
+1
-1
@@ -5,7 +5,7 @@ cabal-version: 1.12
|
|||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
|
|
||||||
name: utoy
|
name: utoy
|
||||||
version: 0.5
|
version: 0.6
|
||||||
author: Paul Brinkmeier
|
author: Paul Brinkmeier
|
||||||
maintainer: hallo@pbrinkmeier.de
|
maintainer: hallo@pbrinkmeier.de
|
||||||
copyright: 2023 Paul Brinkmeier
|
copyright: 2023 Paul Brinkmeier
|
||||||
|
|||||||
Reference in New Issue
Block a user