packages feed

opentheory-unicode (empty) → 1.137

raw patch · 6 files changed

+303/−0 lines, 6 filesdep +QuickCheckdep +basedep +opentheorysetup-changed

Dependencies added: QuickCheck, base, opentheory, opentheory-bits, opentheory-byte, opentheory-parser, opentheory-primitive, opentheory-probability

Files

+ 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-unicode.cabal view
@@ -0,0 +1,49 @@+name: opentheory-unicode+version: 1.137+category: Text+synopsis: Unicode characters+license: MIT+license-file: LICENSE+cabal-version: >= 1.8.0.2+build-type: Simple+author: Joe Leslie-Hurd <joe@gilith.com>+maintainer: Joe Leslie-Hurd <joe@gilith.com>+description:+  Unicode characters - this package was automatically generated from the+  OpenTheory package char-1.137++library+  build-depends:+    base >= 4.0 && < 5.0,+    QuickCheck >= 2.4.0.1 && < 3.0,+    opentheory-primitive >= 1.3 && < 2.0,+    opentheory >= 1.193 && < 1.196,+    opentheory-byte >= 1.123 && < 1.124,+    opentheory-bits >= 1.63 && < 1.64,+    opentheory-parser >= 1.154 && < 1.156,+    opentheory-probability >= 1.46 && < 1.47++  hs-source-dirs: src++  ghc-options: -Wall++  exposed-modules:+    OpenTheory.Unicode+    OpenTheory.Unicode.UTF8++executable opentheory-unicode-test+  build-depends:+    base >= 4.0 && < 5.0,+    QuickCheck >= 2.4.0.1 && < 3.0,+    opentheory-primitive >= 1.3 && < 2.0,+    opentheory >= 1.193 && < 1.196,+    opentheory-byte >= 1.123 && < 1.124,+    opentheory-bits >= 1.63 && < 1.64,+    opentheory-parser >= 1.154 && < 1.156,+    opentheory-probability >= 1.46 && < 1.47++  hs-source-dirs: src, testsrc++  ghc-options: -Wall++  main-is: Main.hs
+ src/OpenTheory/Unicode.hs view
@@ -0,0 +1,55 @@+{- |+module: $Header$+description: Unicode characters+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}++module OpenTheory.Unicode+where++import qualified OpenTheory.Natural.Bits as Bits+import qualified OpenTheory.Natural.Uniform as Uniform+import qualified OpenTheory.Primitive.Natural as Natural+import qualified OpenTheory.Primitive.Random as Random+import qualified Test.QuickCheck as QuickCheck++newtype Unicode = Unicode { unUnicode :: Natural.Natural }+  deriving (Eq, Ord, Show)++destPlane :: Natural.Natural -> Natural.Natural+destPlane n = Bits.shiftRight n 16++destPosition :: Natural.Natural -> Natural.Natural+destPosition n = Bits.bound n 16++invariant :: Natural.Natural -> Bool+invariant n =+  let pl = destPlane n in+  let pos = destPosition n in+  pos < 65534 &&+  if not (pl == 0) then pl < 17+  else+    not (55296 <= pos && pos < 57344) && not (64976 <= pos && pos < 65008)++plane :: Unicode -> Natural.Natural+plane = destPlane . unUnicode++position :: Unicode -> Natural.Natural+position = destPosition . unUnicode++random :: Random.Random -> Unicode+random r =+  let n0 = Uniform.random 1111998 r in+  let n1 = if n0 < 55296 then n0 else n0 + 2048 in+  let n2 = if n1 < 64976 then n1 else n1 + 32 in+  let pl = n2 `div` 65534 in+  let pos = n2 `mod` 65534 in+  let n = pos + Bits.shiftLeft pl 16 in+  Unicode n++instance  QuickCheck.Arbitrary Unicode where+  arbitrary = fmap random QuickCheck.arbitrary
+ src/OpenTheory/Unicode/UTF8.hs view
@@ -0,0 +1,133 @@+{- |+module: $Header$+description: Unicode characters+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}++module OpenTheory.Unicode.UTF8+where++import qualified OpenTheory.Natural.Bits as Bits+import qualified OpenTheory.Parser as Parser+import qualified OpenTheory.Parser.Stream as Stream+import qualified OpenTheory.Primitive.Byte as Byte+import qualified OpenTheory.Primitive.Natural as Natural+import qualified OpenTheory.Unicode as Unicode++parseAscii :: Parser.Parser Byte.Byte Natural.Natural+parseAscii =+  Parser.token+    (\b -> if Byte.bit b 7 then Nothing else Just (Byte.toNatural b))++isContinuationByte :: Byte.Byte -> Bool+isContinuationByte b = Byte.bit b 7 && not (Byte.bit b 6)++parseMultibyte :: Parser.Parser Byte.Byte Natural.Natural+parseMultibyte =+  Parser.sequenceParser+    (Parser.token+       (\b ->+          if Byte.bit b 6 then+            if Byte.bit b 5 then+              if Byte.bit b 4 then+                if Byte.bit b 3 then Nothing else Just (parse4 b)+              else Just (parse3 b)+            else Just (parse2 b)+          else Nothing))+  where+  {-parse2 :: Byte.Byte -> Parser.Parser Byte.Byte Natural.Natural-}+    parse2 b =+      Parser.filterParser+        (Parser.foldN addContinuationByte 0+           (Byte.toNatural (Byte.and b 31))) (\n -> 128 <= n)++  {-parse3 :: Byte.Byte -> Parser.Parser Byte.Byte Natural.Natural-}+    parse3 b =+      Parser.filterParser+        (Parser.foldN addContinuationByte 1+           (Byte.toNatural (Byte.and b 15))) (\n -> 2048 <= n)++  {-parse4 :: Byte.Byte -> Parser.Parser Byte.Byte Natural.Natural-}+    parse4 b =+      Parser.filterParser+        (Parser.foldN addContinuationByte 2+           (Byte.toNatural (Byte.and b 7))) (\n -> 65536 <= n)++  {-addContinuationByte ::+        Byte.Byte -> Natural.Natural -> Maybe Natural.Natural-}+    addContinuationByte b n =+      if isContinuationByte b then+        Just (Byte.toNatural (Byte.and b 63) + Bits.shiftLeft n 6)+      else Nothing++parseNatural :: Parser.Parser Byte.Byte Natural.Natural+parseNatural = Parser.orelse parseAscii parseMultibyte++parseUnicode :: Parser.Parser Byte.Byte Unicode.Unicode+parseUnicode =+  Parser.mapPartial parseNatural+    (\n ->+       if Unicode.invariant n then Just (Unicode.Unicode n) else Nothing)++parse :: Parser.Parser Byte.Byte (Either Byte.Byte Unicode.Unicode)+parse =+  Parser.orelse (Parser.mapParser parseUnicode Right)+    (Parser.mapParser Parser.anyToken Left)++decode :: [Byte.Byte] -> [Either Byte.Byte Unicode.Unicode]+decode b = fst (Stream.toList (Parser.parse parse (Stream.fromList b)))++encodeAscii :: Natural.Natural -> [Byte.Byte]+encodeAscii n = Byte.fromNatural n : []++encodeUnicode :: Unicode.Unicode -> [Byte.Byte]+encodeUnicode =+  \c ->+    let n = Unicode.unUnicode c in+    if n < 128 then encodeAscii n+    else if n < 2048 then encode2 n+    else if n < 65536 then encode3 n+    else encode4 n+  where+  {-encode2 :: Natural.Natural -> [Byte.Byte]-}+    encode2 n =+      let n1 = Bits.shiftRight n 6 in+      let b0 = Byte.or 192 (Byte.fromNatural n1) in+      let b1 = Byte.or 128 (Byte.fromNatural (Bits.bound n 6)) in+      b0 : b1 : []++  {-encode3 :: Natural.Natural -> [Byte.Byte]-}+    encode3 n =+      let n1 = Bits.shiftRight n 6 in+      let n2 = Bits.shiftRight n1 6 in+      let b0 = Byte.or 224 (Byte.fromNatural n2) in+      let b1 = Byte.or 128 (Byte.fromNatural (Bits.bound n1 6)) in+      let b2 = Byte.or 128 (Byte.fromNatural (Bits.bound n 6)) in+      b0 : b1 : b2 : []++  {-encode4 :: Natural.Natural -> [Byte.Byte]-}+    encode4 n =+      let n1 = Bits.shiftRight n 6 in+      let n2 = Bits.shiftRight n1 6 in+      let n3 = Bits.shiftRight n2 6 in+      let b0 = Byte.or 240 (Byte.fromNatural n3) in+      let b1 = Byte.or 128 (Byte.fromNatural (Bits.bound n2 6)) in+      let b2 = Byte.or 128 (Byte.fromNatural (Bits.bound n1 6)) in+      let b3 = Byte.or 128 (Byte.fromNatural (Bits.bound n 6)) in+      b0 : b1 : b2 : b3 : []++encode :: [Unicode.Unicode] -> [Byte.Byte]+encode c = concat (map encodeUnicode c)++reencodeUnicode :: Either Byte.Byte Unicode.Unicode -> [Byte.Byte]+reencodeUnicode x =+  case x of+    Left b -> b : []+    Right c -> encodeUnicode c++reencode :: [Either Byte.Byte Unicode.Unicode] -> [Byte.Byte]+reencode c = concat (map reencodeUnicode c)
+ testsrc/Main.hs view
@@ -0,0 +1,43 @@+{- |+module: Main+description: Unicode characters - testing+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module Main+  ( main )+where++import qualified OpenTheory.List as List+import qualified OpenTheory.Primitive.Byte as Byte+import qualified OpenTheory.Unicode as Unicode+import qualified OpenTheory.Unicode.UTF8 as UTF8+import OpenTheory.Primitive.Test++proposition0 :: [Byte.Byte] -> Bool+proposition0 b = UTF8.reencode (UTF8.decode b) == b++proposition1 :: [Byte.Byte] -> Bool+proposition1 b = List.naturalLength (UTF8.decode b) <= List.naturalLength b++proposition2 :: [Unicode.Unicode] -> Bool+proposition2 c = List.naturalLength c <= List.naturalLength (UTF8.encode c)++proposition3 :: [Either Byte.Byte Unicode.Unicode] -> Bool+proposition3 c =+  List.naturalLength c <= List.naturalLength (UTF8.reencode c)++proposition4 :: [Unicode.Unicode] -> Bool+proposition4 c = UTF8.decode (UTF8.encode c) == map Right c++main :: IO ()+main =+    do check "Proposition 0:\n  !b. UTF8.reencode (UTF8.decode b) = b\n  " proposition0+       check "Proposition 1:\n  !b. length (UTF8.decode b) <= length b\n  " proposition1+       check "Proposition 2:\n  !c. length c <= length (UTF8.encode c)\n  " proposition2+       check "Proposition 3:\n  !c. length c <= length (UTF8.reencode c)\n  " proposition3+       check "Proposition 4:\n  !c. UTF8.decode (UTF8.encode c) = map right c\n  " proposition4+       return ()