diff --git a/Dot.hs b/Dot.hs --- a/Dot.hs +++ b/Dot.hs @@ -93,7 +93,12 @@ -- Prettyprinters instance Show Param where - show (Label l) = "label=\""++l++"\"" + show (Label l) = "label=\""++quote l++"\"" + where + quote "" = "" + quote s = concatMap quote' s + quote' '"' = "\\\"" + quote' x = [x] show (Style s) = "style="++show s show (Constraint x) = "constraint=" ++ showB x where diff --git a/Text/UTF8.hs b/Text/UTF8.hs deleted file mode 100644 --- a/Text/UTF8.hs +++ /dev/null @@ -1,376 +0,0 @@ -{- - -Copyright (c) 2002, members of the Haskell Internationalisation Working -Group All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -* Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -* Neither the name of the Haskell Internationalisation Working Group nor - the names of its contributors may be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. - -This module provides lazy stream encoding/decoding facilities for UTF-8, -the Unicode Transformation Format with 8-bit words. - -2002-09-02 Sven Moritz Hallberg - --} - -{- - -2007-04-30 Henning Thielemann: -Slight changes to make decode lazy. -The calls of 'reverse' in the original version have broken laziness -and thus had memory leaks. - --} - -module Text.UTF8 - ( fromUTF8, toUTF8, - encode, decode, - decodeEmbedErrors, - encodeOne, decodeOne, - Error, -- Haddock does not want to document signatures with private types - -- these functions should be moved to a utility module - ) where - -import Data.Char (ord, chr) -import Data.Word (Word8, Word16, Word32) -import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.)) - -import Data.List (unfoldr) - -toUTF8 :: String -> String -toUTF8 s = (map (chr. fromIntegral) $ encode s) -fromUTF8 :: String -> (String, [(Error, Int)]) -fromUTF8 s = decode (map (fromIntegral . ord) s) - --- - UTF-8 in General - - --- Adapted from the Unicode standard, version 3.2, --- Table 3.1 "UTF-8 Bit Distribution" (excluded are UTF-16 encodings): - --- Scalar 1st Byte 2nd Byte 3rd Byte 4th Byte --- 000000000xxxxxxx 0xxxxxxx --- 00000yyyyyxxxxxx 110yyyyy 10xxxxxx --- zzzzyyyyyyxxxxxx 1110zzzz 10yyyyyy 10xxxxxx --- 000uuuzzzzzzyyyyyyxxxxxx 11110uuu 10zzzzzz 10yyyyyy 10xxxxxx - --- Also from the Unicode standard, version 3.2, --- Table 3.1B "Legal UTF-8 Byte Sequences": - --- Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte --- U+0000..U+007F 00..7F --- U+0080..U+07FF C2..DF 80..BF --- U+0800..U+0FFF E0 A0..BF 80..BF --- U+1000..U+CFFF E1..EC 80..BF 80..BF --- U+D000..U+D7FF ED 80..9F 80..BF --- U+D800..U+DFFF ill-formed --- U+E000..U+FFFF EE..EF 80..BF 80..BF --- U+10000..U+3FFFF F0 90..BF 80..BF 80..BF --- U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF --- U+100000..U+10FFFF F4 80..8F 80..BF 80..BF - - - --- - Encoding Functions - - --- Must the encoder ensure that no illegal byte sequences are output or --- can we trust the Haskell system to supply only legal values? --- For now I include error case for the surrogate values U+D800..U+DFFF and --- out-of-range scalars. - --- The function is pretty much a transscript of table 3.1B with error checks. --- It dispatches the actual encoding to functions specific to the number of --- required bytes. - -encodeOne :: Char -> [Word8] -encodeOne c - -- The report guarantees in (6.1.2) that this won't happen: - -- | n < 0 = error "encodeUTF8: ord returned a negative value" - | n < 0x0080 = encodeOne_onebyte n8 - | n < 0x0800 = encodeOne_twobyte n16 - | n < 0xD800 = encodeOne_threebyte n16 - | n < 0xE000 = error "encodeUTF8: ord returned a surrogate value" - | n < 0x10000 = encodeOne_threebyte n16 - -- Haskell 98 only talks about 16 bit characters, but ghc handles 20.1. - | n < 0x10FFFF = encodeOne_fourbyte n32 - | otherwise = error "encodeUTF8: ord returned a value above 0x10FFFF" - where - n = ord c :: Int - n8 = fromIntegral n :: Word8 - n16 = fromIntegral n :: Word16 - n32 = fromIntegral n :: Word32 - - --- With the above, a stream decoder is trivial: - -encode :: String -> [Word8] -encode = concatMap encodeOne - - --- Now follow the individual encoders for certain numbers of bytes... --- _ --- / | __ ___ __ __ --- / ^| // /__/ // // --- /.==| \\ //_ // // --- It's // || // \_/_//_//_ and it's here to stay! - -encodeOne_onebyte :: Word8 -> [Word8] -encodeOne_onebyte cp = [cp] - - --- 00000yyyyyxxxxxx -> 110yyyyy 10xxxxxx - -encodeOne_twobyte :: Word16 -> [Word8] -encodeOne_twobyte cp = [(0xC0.|.ys), (0x80.|.xs)] - where - xs, ys :: Word8 - ys = fromIntegral (shiftR cp 6) - xs = (fromIntegral cp) .&. 0x3F - - --- zzzzyyyyyyxxxxxx -> 1110zzzz 10yyyyyy 10xxxxxx - -encodeOne_threebyte :: Word16 -> [Word8] -encodeOne_threebyte cp = [(0xE0.|.zs), (0x80.|.ys), (0x80.|.xs)] - where - xs, ys, zs :: Word8 - xs = (fromIntegral cp) .&. 0x3F - ys = (fromIntegral (shiftR cp 6)) .&. 0x3F - zs = fromIntegral (shiftR cp 12) - - --- 000uuuzzzzzzyyyyyyxxxxxx -> 11110uuu 10zzzzzz 10yyyyyy 10xxxxxx - -encodeOne_fourbyte :: Word32 -> [Word8] -encodeOne_fourbyte cp = [0xF0.|.us, 0x80.|.zs, 0x80.|.ys, 0x80.|.xs] - where - xs, ys, zs, us :: Word8 - xs = (fromIntegral cp) .&. 0x3F - ys = (fromIntegral (shiftR cp 6)) .&. 0x3F - zs = (fromIntegral (shiftR cp 12)) .&. 0x3F - us = fromIntegral (shiftR cp 18) - - - --- - Decoding - - --- The decoding is a bit more involved. The byte sequence could contain all --- sorts of corruptions. The user must be able to either notice or ignore these --- errors. - --- I will first look at the decoding of a single character. The process --- consumes a certain number of bytes from the input. It returns the --- remaining input and either an error and the index of its occurance in the --- byte sequence or the decoded character. - -data Error - --- The first byte in a sequence starts with either zero, two, three, or four --- ones and one zero to indicate the length of the sequence. If it doesn't, --- it is invalid. It is dropped and the next byte interpreted as the start --- of a new sequence. - - = InvalidFirstByte - --- All bytes in the sequence except the first match the bit pattern 10xxxxxx. --- If one doesn't, it is invalid. The sequence up to that point is dropped --- and the "invalid" byte interpreted as the start of a new sequence. The error --- includes the length of the partial sequence and the number of expected bytes. - - | InvalidLaterByte Int -- the byte at relative index n was invalid - --- If a sequence ends prematurely, it has been truncated. It dropped and --- decoding stops. The error reports the actual and expected lengths of the --- sequence. - - | Truncated Int Int -- only n of m expected bytes were present - --- Some sequences would represent code points which would be encoded as a --- shorter sequence by a conformant encoder. Such non-shortest sequences are --- considered erroneous and dropped. The error reports the actual and --- expected number of bytes used. - - | NonShortest Int Int -- n instead of m bytes were used - --- Unicode code points are in the range of [0..0x10FFFF]. Any values outside --- of those bounds are simply invalid. - - | ValueOutOfBounds - --- There is no such thing as "surrogate pairs" any more in UTF-8. The --- corresponding code points now form illegal byte sequences. - - | Surrogate - deriving (Show, Eq) - - --- Second, third, and fourth bytes share the common requirement to start --- with the bit sequence 10. So, here's the function to check that property. - -first_bits_not_10 :: Word8 -> Bool -first_bits_not_10 b - | (b.&.0xC0) /= 0x80 = True - | otherwise = False - - --- Erm, OK, the single-character decoding function's return type is a bit --- longish. It is a tripel: - --- - The first component contains the decoded character or an error --- if the byte sequence was erroneous. --- - The second component contains the number of bytes that were consumed --- from the input. --- - The third component contains the remaining bytes of input. - -decodeOne :: [Word8] -> (Either Error Char, Int, [Word8]) -decodeOne bs@(b1:rest) - | b1 < 0x80 = decodeOne_onebyte bs - | b1 < 0xC0 = (Left InvalidFirstByte, 1, rest) - | b1 < 0xE0 = decodeOne_twobyte bs - | b1 < 0xF0 = decodeOne_threebyte bs - | b1 < 0xF5 = decodeOne_fourbyte bs - | otherwise = (Left ValueOutOfBounds, 1, rest) -decodeOne [] = error "UTF8.decodeOne: No input" - - --- 0xxxxxxx -> 000000000xxxxxxx - -decodeOne_onebyte :: [Word8] -> (Either Error Char, Int, [Word8]) -decodeOne_onebyte (b:bs) = (Right (cpToChar b), 1, bs) -decodeOne_onebyte[] = error "UTF8.decodeOne_onebyte: No input (can't happen)" - -cpToChar :: Integral a => a -> Char -cpToChar = chr . fromIntegral - - --- 110yyyyy 10xxxxxx -> 00000yyyyyxxxxxx - -decodeOne_twobyte :: [Word8] -> (Either Error Char, Int, [Word8]) -decodeOne_twobyte (_:[]) - = (Left (Truncated 1 2), 1, []) -decodeOne_twobyte (b1:b2:bs) - | b1 < 0xC2 = (Left (NonShortest 2 1), 2, bs) - | first_bits_not_10 b2 = (Left (InvalidLaterByte 1), 1, (b2:bs)) - | otherwise = (Right (cpToChar result), 2, bs) - where - xs, ys, result :: Word32 - xs = fromIntegral (b2.&.0x3F) - ys = fromIntegral (b1.&.0x1F) - result = shiftL ys 6 .|. xs -decodeOne_twobyte[] = error "UTF8.decodeOne_twobyte: No input (can't happen)" - - --- 1110zzzz 10yyyyyy 10xxxxxx -> zzzzyyyyyyxxxxxx - -decodeOne_threebyte :: [Word8] -> (Either Error Char, Int, [Word8]) -decodeOne_threebyte (_:[]) = threebyte_truncated 1 -decodeOne_threebyte (_:_:[]) = threebyte_truncated 2 -decodeOne_threebyte bs@(b1:b2:b3:rest) - | first_bits_not_10 b2 - = (Left (InvalidLaterByte 1), 1, drop 1 bs) - | first_bits_not_10 b3 - = (Left (InvalidLaterByte 2), 2, drop 2 bs) - | result < 0x0080 - = (Left (NonShortest 3 1), 3, rest) - | result < 0x0800 - = (Left (NonShortest 3 2), 3, rest) - | result >= 0xD800 && result < 0xE000 - = (Left Surrogate, 3, rest) - | otherwise - = (Right (cpToChar result), 3, rest) - where - xs, ys, zs, result :: Word32 - xs = fromIntegral (b3.&.0x3F) - ys = fromIntegral (b2.&.0x3F) - zs = fromIntegral (b1.&.0x0F) - result = shiftL zs 12 .|. shiftL ys 6 .|. xs -decodeOne_threebyte[] - = error "UTF8.decodeOne_threebyte: No input (can't happen)" - -threebyte_truncated :: Int -> (Either Error Char, Int, [Word8]) -threebyte_truncated n = (Left (Truncated n 3), n, []) - - --- 11110uuu 10zzzzzz 10yyyyyy 10xxxxxx -> 000uuuzzzzzzyyyyyyxxxxxx - -decodeOne_fourbyte :: [Word8] -> (Either Error Char, Int, [Word8]) -decodeOne_fourbyte (_:[]) = fourbyte_truncated 1 -decodeOne_fourbyte (_:_:[]) = fourbyte_truncated 2 -decodeOne_fourbyte (_:_:_:[]) = fourbyte_truncated 3 -decodeOne_fourbyte bs@(b1:b2:b3:b4:rest) - | first_bits_not_10 b2 - = (Left (InvalidLaterByte 1), 1, drop 1 bs) - | first_bits_not_10 b3 - = (Left (InvalidLaterByte 2), 2, drop 2 bs) - | first_bits_not_10 b4 - = (Left (InvalidLaterByte 3), 3, drop 3 bs) - | result < 0x0080 - = (Left (NonShortest 4 1), 4, rest) - | result < 0x0800 - = (Left (NonShortest 4 2), 4, rest) - | result < 0x10000 - = (Left (NonShortest 4 3), 4, rest) - | result > 0x10FFFF - = (Left ValueOutOfBounds, 4, rest) - | otherwise - = (Right (cpToChar result), 4, rest) - where - xs, ys, zs, us, result :: Word32 - xs = fromIntegral (b4 .&. 0x3F) - ys = fromIntegral (b3 .&. 0x3F) - zs = fromIntegral (b2 .&. 0x3F) - us = fromIntegral (b1 .&. 0x07) - result = xs .|. shiftL ys 6 .|. shiftL zs 12 .|. shiftL us 18 -decodeOne_fourbyte[] - = error "UTF8.decodeOne_fourbyte: No input (can't happen)" - -fourbyte_truncated :: Int -> (Either Error Char, Int, [Word8]) -fourbyte_truncated n = (Left (Truncated n 4), n, []) - - --- The decoder examines all input, recording decoded characters as well as --- error-index pairs along the way. - -decode :: [Word8] -> (String, [(Error,Int)]) -decode = swap . partitionEither . decodeEmbedErrors - -decodeEmbedErrors :: [Word8] -> [Either (Error,Int) Char] -decodeEmbedErrors = - unfoldr (\(pos,xs) -> - toMaybe - (not $ null xs) - (let (c,n,rest) = decodeOne xs - in (either (\err -> Left (err,pos)) Right c, - (pos+n,rest)))) . - (,) 0 - -swap :: (a,b) -> (b,a) -swap (x,y) = (y,x) - -partitionEither :: [Either a b] -> ([a], [b]) -partitionEither = - foldr (\x ~(ls,rs) -> either (\l -> (l:ls,rs)) (\r -> (ls,r:rs)) x) ([],[]) - -toMaybe :: Bool -> a -> Maybe a -toMaybe False _ = Nothing -toMaybe True x = Just x diff --git a/flow2dot.cabal b/flow2dot.cabal --- a/flow2dot.cabal +++ b/flow2dot.cabal @@ -1,5 +1,5 @@ Name: flow2dot -Version: 0.2.1 +Version: 0.3 License: BSD3 License-File: LICENSE Author: Dmitry Astapov @@ -13,12 +13,12 @@ Stability: Works-for-me, passes tests, generates diagrams Tested-With: GHC ==6.8.2 -Build-Depends: base, mtl >= 1.0, containers, haskell98, QuickCheck, parsec +Build-Depends: base, mtl >= 1.0, containers, haskell98, QuickCheck, parsec, utf8-string Build-Type: Simple Extra-Source-Files: README Executable: flow2dot Main-Is: flow2dot.hs -Other-Modules: Text.UTF8, Dot +Other-Modules: Dot GHC-Options: -Wall Extensions: FlexibleInstances diff --git a/flow2dot.hs b/flow2dot.hs --- a/flow2dot.hs +++ b/flow2dot.hs @@ -18,7 +18,8 @@ import Control.Monad.State (State,evalState,gets,modify) import qualified Data.Map as M import Data.List (intersperse,unfoldr,splitAt) -import Text.UTF8 (fromUTF8, toUTF8) +import Prelude hiding (putStrLn, readFile) +import System.IO.UTF8 (putStrLn, readFile) import Data.Maybe (fromJust) import Data.Char (isSpace) import Test.QuickCheck @@ -84,7 +85,7 @@ process :: FilePath -> IO () process fname = do flow <- parseFlowFromFile fname - putStrLn $ toUTF8 $ processFlow flow + putStrLn $ processFlow flow -- FIXME: remove "zzzz_BODY" and rework section generation to emit body last processFlow :: [Flow] -> String @@ -253,7 +254,7 @@ parseFlowFromFile :: FilePath -> IO [Flow]-- Parser parseFlowFromFile fname = do raw <- readFile fname - return $ parseFlow fname $ fst $ fromUTF8 raw + return $ parseFlow fname raw parseFlow :: String -> String -> [Flow] parseFlow _ "" = []