opentheory-char (empty) → 1.30
raw patch · 6 files changed
+377/−0 lines, 6 filesdep +QuickCheckdep +basedep +opentheorysetup-changed
Dependencies added: QuickCheck, base, opentheory, opentheory-parser, opentheory-primitive, random
Files
- LICENSE +17/−0
- Setup.hs +6/−0
- opentheory-char.cabal +45/−0
- src/OpenTheory/Data/Unicode.hs +59/−0
- src/OpenTheory/Data/Unicode/UTF8.hs +195/−0
- testsrc/Test.hs +55/−0
+ LICENSE view
@@ -0,0 +1,17 @@+Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main(main)++import Distribution.Simple++main :: IO ()+main = defaultMain
+ opentheory-char.cabal view
@@ -0,0 +1,45 @@+name: opentheory-char+version: 1.30+category: Text+synopsis: Unicode characters+license: MIT+license-file: LICENSE+cabal-version: >= 1.8.0.6+build-type: Simple+author: Joe Hurd <joe@gilith.com>+maintainer: Joe Hurd <joe@gilith.com>+description:+ Unicode characters+ Automatically generated from the opentheory package haskell-char-1.30++library+ build-depends:+ base >= 4.0 && < 5.0,+ random >= 1.0.1.1 && < 2.0,+ QuickCheck >= 2.4.0.1 && < 3.0,+ opentheory-primitive >= 1.0 && < 2.0,+ opentheory >= 1.52 && <= 1.61,+ opentheory-parser >= 1.93 && <= 1.105++ hs-source-dirs: src++ ghc-options: -Wall++ exposed-modules:+ OpenTheory.Data.Unicode+ OpenTheory.Data.Unicode.UTF8++executable opentheory-char-test+ build-depends:+ base >= 4.0 && < 5.0,+ random >= 1.0.1.1 && < 2.0,+ QuickCheck >= 2.4.0.1 && < 3.0,+ opentheory-primitive >= 1.0 && < 2.0,+ opentheory >= 1.52 && <= 1.61,+ opentheory-parser >= 1.93 && <= 1.105++ hs-source-dirs: src, testsrc++ ghc-options: -Wall++ main-is: Test.hs
+ src/OpenTheory/Data/Unicode.hs view
@@ -0,0 +1,59 @@+{- |+module: $Header$+description: Unicode characters+license: MIT++maintainer: Joe Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module OpenTheory.Data.Unicode+where++import qualified OpenTheory.Data.Word16 as Data.Word16+import qualified OpenTheory.Number.Natural.Uniform+ as Number.Natural.Uniform+import qualified OpenTheory.Primitive.Byte as Primitive.Byte+import qualified OpenTheory.Primitive.Random as Primitive.Random+import qualified OpenTheory.Primitive.Word16 as Primitive.Word16++newtype Plane = Plane { unPlane :: Primitive.Byte.Byte }++newtype Position = Position { unPosition :: Primitive.Word16.Word16 }++newtype Unicode = Unicode { unUnicode :: (Plane, Position) }++equalPlane :: Plane -> Plane -> Bool+equalPlane p1 p2 = unPlane p1 == unPlane p2++equalPosition :: Position -> Position -> Bool+equalPosition p1 p2 = unPosition p1 == unPosition p2++equal :: Unicode -> Unicode -> Bool+equal c1 c2 =+ let (pl1, pos1) = unUnicode c1 in+ let (pl2, pos2) = unUnicode c2 in+ equalPlane pl1 pl2 && equalPosition pos1 pos2++planeFromRandom ::+ Primitive.Random.Random -> (Plane, Primitive.Random.Random)+planeFromRandom r =+ let (n, r') = Number.Natural.Uniform.fromRandom 17 r in+ (Plane (Primitive.Byte.fromNatural n), r')++positionFromRandom ::+ Primitive.Random.Random -> (Position, Primitive.Random.Random)+positionFromRandom r =+ let (w, r') = Data.Word16.fromRandom r in (Position w, r')++fromRandom :: Primitive.Random.Random -> (Unicode, Primitive.Random.Random)+fromRandom r =+ let (pl, r') = planeFromRandom r in+ let pli = unPlane pl in+ let (pos, r'') =+ if not (pli == 0) then positionFromRandom r'+ else+ let (n, r''') = Number.Natural.Uniform.fromRandom 63486 r' in+ let n' = if n < 55296 then n else n + 2048 in+ (Position (Primitive.Word16.fromNatural n'), r''') in+ (Unicode (pl, pos), r'')
+ src/OpenTheory/Data/Unicode/UTF8.hs view
@@ -0,0 +1,195 @@+{- |+module: $Header$+description: Unicode characters+license: MIT++maintainer: Joe Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module OpenTheory.Data.Unicode.UTF8+where++import qualified OpenTheory.Data.Unicode as Data.Unicode+import qualified OpenTheory.Parser as Parser+import qualified OpenTheory.Parser.Stream as Parser.Stream+import qualified OpenTheory.Primitive.Byte as Primitive.Byte+import qualified OpenTheory.Primitive.Word16 as Primitive.Word16++isContinuationByte :: Primitive.Byte.Byte -> Bool+isContinuationByte b =+ Primitive.Byte.bit b 7 && not (Primitive.Byte.bit b 6)++parseContinuationByte ::+ Parser.Parser Primitive.Byte.Byte Primitive.Byte.Byte+parseContinuationByte = Parser.parseSome isContinuationByte++parseTwoContinuationBytes ::+ Parser.Parser Primitive.Byte.Byte+ (Primitive.Byte.Byte, Primitive.Byte.Byte)+parseTwoContinuationBytes =+ Parser.parsePair parseContinuationByte parseContinuationByte++parseThreeContinuationBytes ::+ Parser.Parser Primitive.Byte.Byte+ (Primitive.Byte.Byte, (Primitive.Byte.Byte, Primitive.Byte.Byte))+parseThreeContinuationBytes =+ Parser.parsePair parseContinuationByte parseTwoContinuationBytes++decoder :: Parser.Parser Primitive.Byte.Byte Data.Unicode.Unicode+decoder =+ Parser.Parser parse+ where+ {-parse ::+ Primitive.Byte.Byte -> Parser.Stream.Stream Primitive.Byte.Byte ->+ Maybe+ (Data.Unicode.Unicode,+ Parser.Stream.Stream Primitive.Byte.Byte)-}+ parse b0 s =+ if Primitive.Byte.bit b0 7 then+ if Primitive.Byte.bit b0 6 then+ if Primitive.Byte.bit b0 5 then+ if Primitive.Byte.bit b0 4 then+ if Primitive.Byte.bit b0 3 then Nothing+ else+ Parser.parse+ (Parser.partialMap (decode3 b0)+ parseThreeContinuationBytes) s+ else+ Parser.parse+ (Parser.partialMap (decode2 b0) parseTwoContinuationBytes)+ s+ else+ Parser.parse+ (Parser.partialMap (decode1 b0) parseContinuationByte) s+ else Nothing+ else+ let pl = Data.Unicode.Plane 0 in+ let pos =+ Data.Unicode.Position (Primitive.Word16.fromBytes b0 0) in+ let ch = Data.Unicode.Unicode (pl, pos) in+ Just (ch, s)++ {-decode1 ::+ Primitive.Byte.Byte -> Primitive.Byte.Byte ->+ Maybe Data.Unicode.Unicode-}+ decode1 b0 b1 =+ let pl = Data.Unicode.Plane 0 in+ let p1 = Primitive.Byte.shiftRight (Primitive.Byte.and b0 28) 2 in+ let y0 = Primitive.Byte.shiftLeft (Primitive.Byte.and b0 3) 6 in+ let x0 = Primitive.Byte.and b1 63 in+ let p0 = Primitive.Byte.or y0 x0 in+ if p1 == 0 && not (Primitive.Byte.bit p0 7) then Nothing+ else+ let pos =+ Data.Unicode.Position (Primitive.Word16.fromBytes p0 p1) in+ let ch = Data.Unicode.Unicode (pl, pos) in+ Just ch++ {-decode2 ::+ Primitive.Byte.Byte ->+ (Primitive.Byte.Byte, Primitive.Byte.Byte) ->+ Maybe Data.Unicode.Unicode-}+ decode2 b0 (b1, b2) =+ let z1 = Primitive.Byte.shiftLeft (Primitive.Byte.and b0 15) 4 in+ let y1 = Primitive.Byte.shiftRight (Primitive.Byte.and b1 60) 2 in+ let p1 = Primitive.Byte.or z1 y1 in+ if p1 < 8 || 216 <= p1 && p1 <= 223 then Nothing+ else+ let y0 = Primitive.Byte.shiftLeft (Primitive.Byte.and b1 3) 6 in+ let x0 = Primitive.Byte.and b2 63 in+ let p0 = Primitive.Byte.or y0 x0 in+ if p1 == 255 && 254 <= p0 then Nothing+ else+ let pl = Data.Unicode.Plane 0 in+ let pos =+ Data.Unicode.Position (Primitive.Word16.fromBytes p0 p1) in+ let ch = Data.Unicode.Unicode (pl, pos) in+ Just ch++ {-decode3 ::+ Primitive.Byte.Byte ->+ (Primitive.Byte.Byte,+ (Primitive.Byte.Byte, Primitive.Byte.Byte)) ->+ Maybe Data.Unicode.Unicode-}+ decode3 b0 (b1, (b2, b3)) =+ let w = Primitive.Byte.shiftLeft (Primitive.Byte.and b0 7) 2 in+ let z = Primitive.Byte.shiftRight (Primitive.Byte.and b1 48) 4 in+ let p = Primitive.Byte.or w z in+ if p == 0 || 16 < p then Nothing+ else+ let pl = Data.Unicode.Plane p in+ let z1 = Primitive.Byte.shiftLeft (Primitive.Byte.and b1 15) 4 in+ let y1 = Primitive.Byte.shiftRight (Primitive.Byte.and b2 60) 2 in+ let p1 = Primitive.Byte.or z1 y1 in+ let y0 = Primitive.Byte.shiftLeft (Primitive.Byte.and b2 3) 6 in+ let x0 = Primitive.Byte.and b3 63 in+ let p0 = Primitive.Byte.or y0 x0 in+ let pos =+ Data.Unicode.Position (Primitive.Word16.fromBytes p0 p1) in+ let ch = Data.Unicode.Unicode (pl, pos) in+ Just ch++decodeStream ::+ Parser.Stream.Stream Primitive.Byte.Byte ->+ Parser.Stream.Stream Data.Unicode.Unicode+decodeStream = Parser.parseStream decoder++decode :: [Primitive.Byte.Byte] -> Maybe [Data.Unicode.Unicode]+decode bs = Parser.Stream.toList (decodeStream (Parser.Stream.fromList bs))++encoder :: Data.Unicode.Unicode -> [Primitive.Byte.Byte]+encoder =+ \ch ->+ let (pl, pos) = Data.Unicode.unUnicode ch in+ let p = Data.Unicode.unPlane pl in+ let (p0, p1) =+ Primitive.Word16.toBytes (Data.Unicode.unPosition pos) in+ if p == 0 then+ if p1 == 0 && not (Primitive.Byte.bit p0 7) then p0 : []+ else if Primitive.Byte.and 248 p1 == 0 then encode1 p1 p0+ else encode2 p1 p0+ else encode3 p p1 p0+ where+ {-encode1 ::+ Primitive.Byte.Byte -> Primitive.Byte.Byte ->+ [Primitive.Byte.Byte]-}+ encode1 p1 p0 =+ let b00 = Primitive.Byte.shiftLeft p1 2 in+ let b01 = Primitive.Byte.shiftRight (Primitive.Byte.and p0 192) 6 in+ let b0 = Primitive.Byte.or 192 (Primitive.Byte.or b00 b01) in+ let b10 = Primitive.Byte.and p0 63 in+ let b1 = Primitive.Byte.or 128 b10 in+ b0 : b1 : []++ {-encode2 ::+ Primitive.Byte.Byte -> Primitive.Byte.Byte ->+ [Primitive.Byte.Byte]-}+ encode2 p1 p0 =+ let b00 = Primitive.Byte.shiftRight (Primitive.Byte.and p1 240) 4 in+ let b0 = Primitive.Byte.or 224 b00 in+ let b10 = Primitive.Byte.shiftLeft (Primitive.Byte.and p1 15) 2 in+ let b11 = Primitive.Byte.shiftRight (Primitive.Byte.and p0 192) 6 in+ let b1 = Primitive.Byte.or 128 (Primitive.Byte.or b10 b11) in+ let b20 = Primitive.Byte.and p0 63 in+ let b2 = Primitive.Byte.or 128 b20 in+ b0 : b1 : b2 : []++ {-encode3 ::+ Primitive.Byte.Byte -> Primitive.Byte.Byte ->+ Primitive.Byte.Byte -> [Primitive.Byte.Byte]-}+ encode3 p p1 p0 =+ let b00 = Primitive.Byte.shiftRight (Primitive.Byte.and p 28) 2 in+ let b0 = Primitive.Byte.or 240 b00 in+ let b10 = Primitive.Byte.shiftLeft (Primitive.Byte.and p 3) 4 in+ let b11 = Primitive.Byte.shiftRight (Primitive.Byte.and p1 240) 4 in+ let b1 = Primitive.Byte.or 128 (Primitive.Byte.or b10 b11) in+ let b20 = Primitive.Byte.shiftLeft (Primitive.Byte.and p1 15) 2 in+ let b21 = Primitive.Byte.shiftRight (Primitive.Byte.and p0 192) 6 in+ let b2 = Primitive.Byte.or 128 (Primitive.Byte.or b20 b21) in+ let b30 = Primitive.Byte.and p0 63 in+ let b3 = Primitive.Byte.or 128 b30 in+ b0 : b1 : b2 : b3 : []++encode :: [Data.Unicode.Unicode] -> [Primitive.Byte.Byte]+encode chs = concat (map encoder chs)
+ testsrc/Test.hs view
@@ -0,0 +1,55 @@+{- |+module: Main+description: Unicode characters - testing+license: MIT++maintainer: Joe Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module Main+ ( main )+where++import qualified OpenTheory.Data.Byte as Data.Byte+import qualified OpenTheory.Data.List as Data.List+import qualified OpenTheory.Data.List.Geometric as Data.List.Geometric+import qualified OpenTheory.Data.Option as Data.Option+import qualified OpenTheory.Data.Unicode as Data.Unicode+import qualified OpenTheory.Data.Unicode.UTF8 as Data.Unicode.UTF8+import qualified OpenTheory.Primitive.Random as Primitive.Random+import qualified OpenTheory.Primitive.Test as Primitive.Test++proposition0 :: Primitive.Random.Random -> Bool+proposition0 r =+ let (cs, _) = Data.List.Geometric.fromRandom Data.Unicode.fromRandom r in+ Data.List.size cs <= Data.List.size (Data.Unicode.UTF8.encode cs)++proposition1 :: Primitive.Random.Random -> Bool+proposition1 r =+ let (cs, _) = Data.List.Geometric.fromRandom Data.Unicode.fromRandom r in+ Data.Option.equal (Data.List.equal Data.Unicode.equal)+ (Data.Unicode.UTF8.decode (Data.Unicode.UTF8.encode cs)) (Just cs)++proposition2 :: Primitive.Random.Random -> Bool+proposition2 r =+ let (bs, _) = Data.List.Geometric.fromRandom Data.Byte.fromRandom r in+ case Data.Unicode.UTF8.decode bs of+ Nothing -> True+ Just cs -> Data.List.equal (==) (Data.Unicode.UTF8.encode cs) bs++proposition3 :: Primitive.Random.Random -> Bool+proposition3 r =+ let (c, _) = Data.Unicode.fromRandom r in+ let (pl, pos) = Data.Unicode.unUnicode c in+ let pli = Data.Unicode.unPlane pl in+ let posi = Data.Unicode.unPosition pos in+ not (pli == 0) || posi < 55296 || 57343 < posi && posi < 65534++main :: IO ()+main =+ do Primitive.Test.check "Proposition 0:\n !r.\n let (cs, r') <- H.Geometric.fromRandom H.fromRandom r in\n H.size cs <= H.size (H.UTF8.encode cs)\n " proposition0+ Primitive.Test.check "Proposition 1:\n !r.\n let (cs, r') <- H.Geometric.fromRandom H.fromRandom r in\n H.equal (H.equal H.equal) (H.UTF8.decode (H.UTF8.encode cs)) (some cs)\n " proposition1+ Primitive.Test.check "Proposition 2:\n !r.\n let (bs, r') <- H.Geometric.fromRandom H.fromRandom r in\n case H.UTF8.decode bs of\n none -> T\n | some cs -> H.equal (=) (H.UTF8.encode cs) bs\n " proposition2+ Primitive.Test.check "Proposition 3:\n !r.\n let (c, r') <- H.fromRandom r in\n let (pl, pos) <- H.unUnicode c in\n let pli <- H.unPlane pl in\n let posi <- H.unPosition pos in\n ~(pli = 0) \\/ posi < 55296 \\/ 57343 < posi /\\ posi < 65534\n " proposition3+ return ()