Compare commits
	
		
			No commits in common. "f5fd1089b19e1921625498f5c5512e977675f9cb" and "da2540c3fa9c5fa7b11352c90c75e0b3d3588140" have entirely different histories.
		
	
	
		
			f5fd1089b1
			...
			da2540c3fa
		
	
		
							
								
								
									
										30
									
								
								app/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										30
									
								
								app/Main.hs
									
									
									
									
									
								
							| @ -63,11 +63,10 @@ app = serve (Proxy :: Proxy API) server | |||||||
| type API = | type API = | ||||||
|   "bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel |   "bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel | ||||||
|   :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel |   :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText] CodepointsModel | ||||||
|   :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel |  | ||||||
| 
 | 
 | ||||||
| server :: Server API | server :: Server API | ||||||
| server = | server = | ||||||
|   bytesR :<|> codepointsR :<|> textR |   bytesR :<|> codepointsR | ||||||
|   where |   where | ||||||
|     bytesR bytesP = do |     bytesR bytesP = do | ||||||
|       bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400 |       bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400 | ||||||
| @ -77,9 +76,6 @@ server = | |||||||
|       codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400 |       codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400 | ||||||
|       pure $ mkCodepointsModel codepoints' |       pure $ mkCodepointsModel codepoints' | ||||||
| 
 | 
 | ||||||
|     textR textP = do |  | ||||||
|       pure $ TextModel textP |  | ||||||
| 
 |  | ||||||
| -- /bytes/<bytes> | -- /bytes/<bytes> | ||||||
| 
 | 
 | ||||||
| newtype BytesModel = BytesModel | newtype BytesModel = BytesModel | ||||||
| @ -122,10 +118,10 @@ instance MimeRender HTML BytesModel where | |||||||
|               H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ err |               H.td ! A.colspan "4" $ H.toHtml $ "Decoding error: " ++ err | ||||||
|             Right c -> do |             Right c -> do | ||||||
|               H.td $ do |               H.td $ do | ||||||
|                 H.input ! A.class_ "charbox" ! A.value (H.toValue [c]) |                 H.input ! A.value (H.toValue [c]) ! A.style "text-align: center; width: 2em; font-size: 1em;" | ||||||
|               H.td $ H.code $ printfHtml "U+%04X" c |               H.td $ H.code $ printfHtml "U+%04X" c | ||||||
|               H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c) |               H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c) | ||||||
|               H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c |               H.td $ H.toHtml $ fromMaybe "" $ blockName c | ||||||
| 
 | 
 | ||||||
| -- /codepoints/<codepoints> | -- /codepoints/<codepoints> | ||||||
| 
 | 
 | ||||||
| @ -162,26 +158,6 @@ instance MimeRender PlainText CodepointsModel where | |||||||
|     | (codepoint, eiC) <- model.codepoints |     | (codepoint, eiC) <- model.codepoints | ||||||
|     ] |     ] | ||||||
| 
 | 
 | ||||||
| -- /text/<text> |  | ||||||
| 
 |  | ||||||
| newtype TextModel = TextModel |  | ||||||
|   { text :: Text |  | ||||||
|   } |  | ||||||
| 
 |  | ||||||
| instance MimeRender HTML TextModel where |  | ||||||
|   mimeRender _ model = renderHtml $ H.docTypeHtml $ do |  | ||||||
|     H.head $ do |  | ||||||
|       H.meta ! A.charset "utf-8" |  | ||||||
|       H.title "utoy" |  | ||||||
|       H.style $ H.toHtml $ Encoding.decodeUtf8 $(embedFile "static/utoy.css") |  | ||||||
|     H.body $ do |  | ||||||
|       H.table $ for_ (Text.unpack model.text) $ \c -> do |  | ||||||
|         H.tr $ do |  | ||||||
|           H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c]) |  | ||||||
|           H.td $ H.code $ printfHtml "U+%04X" c |  | ||||||
|           H.td $ H.code $ H.toHtml $ intercalate ", " $ maybeToList (UnicodeNames.name c) ++ map (++ "*") (UnicodeNames.nameAliases c) |  | ||||||
|           H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c |  | ||||||
| 
 |  | ||||||
| -- Utilities | -- Utilities | ||||||
| 
 | 
 | ||||||
| renderText :: Text -> BL.ByteString | renderText :: Text -> BL.ByteString | ||||||
|  | |||||||
							
								
								
									
										2
									
								
								hie.yaml
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								hie.yaml
									
									
									
									
									
								
							| @ -4,7 +4,7 @@ cradle: | |||||||
|       component: "utoy:lib" |       component: "utoy:lib" | ||||||
| 
 | 
 | ||||||
|     - path: "./app/Main.hs" |     - path: "./app/Main.hs" | ||||||
|       component: "utoy:exe:utoy" |       component: "utoy:exe:utoy-exe" | ||||||
| 
 | 
 | ||||||
|     - path: "./test" |     - path: "./test" | ||||||
|       component: "utoy:test:utoy-test" |       component: "utoy:test:utoy-test" | ||||||
|  | |||||||
| @ -19,9 +19,3 @@ pre, code { | |||||||
| pre { | pre { | ||||||
|   margin: 0; font-size: 0.5em; |   margin: 0; font-size: 0.5em; | ||||||
| } | } | ||||||
| 
 |  | ||||||
| .charbox { |  | ||||||
|   text-align: center; |  | ||||||
|   width: 2em; |  | ||||||
|   font-size: 1em; |  | ||||||
| } |  | ||||||
|  | |||||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user