Compare commits
	
		
			No commits in common. "647b5c2ad1cbac737b2372fdf371e0863a059640" and "fde68ee8339b57737c8db6aa4a53dc9558748dc2" have entirely different histories.
		
	
	
		
			647b5c2ad1
			...
			fde68ee833
		
	
		
							
								
								
									
										26
									
								
								app/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										26
									
								
								app/Main.hs
									
									
									
									
									
								
							| @ -61,17 +61,17 @@ app :: Application | ||||
| app = serve (Proxy :: Proxy API) server | ||||
| 
 | ||||
| type API = | ||||
|   "utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model | ||||
|   "bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel | ||||
|   :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel | ||||
|   :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel | ||||
| 
 | ||||
| server :: Server API | ||||
| server = | ||||
|   utf8R :<|> codepointsR :<|> textR | ||||
|   bytesR :<|> codepointsR :<|> textR | ||||
|   where | ||||
|     utf8R bytesP = do | ||||
|     bytesR bytesP = do | ||||
|       bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400 | ||||
|       pure $ mkUtf8Model bytes | ||||
|       pure $ BytesModel $ Decode.decodeUtf8 bytes | ||||
| 
 | ||||
|     codepointsR codepointsP = do | ||||
|       codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400 | ||||
| @ -82,14 +82,11 @@ server = | ||||
| 
 | ||||
| -- /bytes/<bytes> | ||||
| 
 | ||||
| newtype Utf8Model = Utf8Model | ||||
| newtype BytesModel = BytesModel | ||||
|   { codepoints :: [([Word8], Either String Char)] | ||||
|   } | ||||
| 
 | ||||
| mkUtf8Model :: [Word8] -> Utf8Model | ||||
| mkUtf8Model = Utf8Model . Decode.decodeUtf8 | ||||
| 
 | ||||
| instance MimeRender PlainText Utf8Model where | ||||
| instance MimeRender PlainText BytesModel where | ||||
|   mimeRender _ model = renderText $ | ||||
|     Table.render "  " $ concat | ||||
|       [ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes | ||||
| @ -110,7 +107,7 @@ instance MimeRender PlainText Utf8Model where | ||||
|       | (bytes, eiC) <- model.codepoints | ||||
|       ] | ||||
| 
 | ||||
| instance MimeRender HTML Utf8Model where | ||||
| instance MimeRender HTML BytesModel where | ||||
|   mimeRender _ model = renderHtml $ documentWithBody $ do | ||||
|     H.table $ for_ model.codepoints $ \(bytes, eiC) -> do | ||||
|       H.tr $ do | ||||
| @ -131,14 +128,7 @@ newtype CodepointsModel = CodepointsModel | ||||
|   } | ||||
| 
 | ||||
| mkCodepointsModel :: [(Word, Word)] -> CodepointsModel | ||||
| mkCodepointsModel = | ||||
|   CodepointsModel | ||||
|   -- Limit number of returned codepoints. Otherwise it's | ||||
|   -- too easy to provoke massive response bodies with requests like | ||||
|   -- /codepoints/0-99999999 | ||||
|   . take 100000 | ||||
|   . map go | ||||
|   . concatMap (uncurry enumFromTo) | ||||
| mkCodepointsModel = CodepointsModel . map go . concatMap (uncurry enumFromTo) | ||||
|   where | ||||
|     go codepoint = (codepoint, toChar codepoint) | ||||
| 
 | ||||
|  | ||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user