packages feed

unicode (empty) → 0.0

raw patch · 17 files changed

+740/−0 lines, 17 filesdep +basedep +containersdep +unicodesetup-changed

Dependencies added: base, containers, unicode, utility-ht

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Henning Thielemann 2014++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Data/Char/Block.hs view
@@ -0,0 +1,61 @@+module Data.Char.Block where++import Control.Applicative (Applicative, pure, (<*>), liftA2, )+import Data.Traversable (Traversable, traverse, foldMapDefault, )+import Data.Foldable (Foldable, foldMap, )+++data Row a = Row {left, right :: a} deriving (Eq, Show)+data Block a = Block {upper, lower :: Row a} deriving (Eq, Show)+++instance Functor Row where+   fmap f (Row a b) = Row (f a) (f b)++instance Functor Block where+   fmap f (Block a b) = Block (fmap f a) (fmap f b)+++instance Foldable Row where+   foldMap = foldMapDefault++instance Foldable Block where+   foldMap = foldMapDefault+++instance Traversable Row where+   traverse f (Row a b) = liftA2 Row (f a) (f b)++instance Traversable Block where+   traverse f (Block a b) = liftA2 Block (traverse f a) (traverse f b)+++instance Applicative Row where+   pure a = Row a a+   Row fa fb <*> Row a b = Row (fa a) (fb b)++instance Applicative Block where+   pure a = Block (pure a) (pure a)+   Block fa fb <*> Block a b =+      Block (fa <*> a) (fb <*> b)+++filled :: Block Bool -> Char+filled set =+   case set of+      Block (Row False False) (Row False False) -> ' '+      Block (Row False False) (Row False True) -> '\x2597'+      Block (Row False False) (Row True False) -> '\x2596'+      Block (Row False False) (Row True True) -> '\x2584'+      Block (Row False True) (Row False False) -> '\x259D'+      Block (Row False True) (Row False True) -> '\x2590'+      Block (Row False True) (Row True False) -> '\x259E'+      Block (Row False True) (Row True True) -> '\x259F'+      Block (Row True False) (Row False False) -> '\x2598'+      Block (Row True False) (Row False True) -> '\x259A'+      Block (Row True False) (Row True False) -> '\x258C'+      Block (Row True False) (Row True True) -> '\x2599'+      Block (Row True True) (Row False False) -> '\x2580'+      Block (Row True True) (Row False True) -> '\x259C'+      Block (Row True True) (Row True False) -> '\x259B'+      Block (Row True True) (Row True True) -> '\x2588'
+ src/Data/Char/Frame.hs view
@@ -0,0 +1,249 @@+module Data.Char.Frame where++import Control.Applicative (Applicative, pure, (<*>), liftA2, )+import Data.Traversable (Traversable, traverse, foldMapDefault, )+import Data.Foldable (Foldable, foldMap, )+import Data.Monoid (Monoid, mempty, mappend, )+++data Horizontal a = Horizontal {left, right :: a} deriving (Eq, Show)+data Vertical a = Vertical {up, down :: a} deriving (Eq, Show)+data Parts a = Parts (Vertical a) (Horizontal a) deriving (Eq, Show)++instance Monoid a => Monoid (Horizontal a) where+   mempty = Horizontal mempty mempty+   mappend (Horizontal xl xr) (Horizontal yl yr) =+      Horizontal (mappend xl yl) (mappend xr yr)++instance Monoid a => Monoid (Vertical a) where+   mempty = Vertical mempty mempty+   mappend (Vertical xl xr) (Vertical yl yr) =+      Vertical (mappend xl yl) (mappend xr yr)++instance Monoid a => Monoid (Parts a) where+   mempty = Parts mempty mempty+   mappend (Parts xl xr) (Parts yl yr) =+      Parts (mappend xl yl) (mappend xr yr)+++instance Functor Horizontal where+   fmap f (Horizontal a b) = Horizontal (f a) (f b)++instance Functor Vertical where+   fmap f (Vertical a b) = Vertical (f a) (f b)++instance Functor Parts where+   fmap f (Parts a b) = Parts (fmap f a) (fmap f b)+++instance Foldable Horizontal where+   foldMap = foldMapDefault++instance Foldable Vertical where+   foldMap = foldMapDefault++instance Foldable Parts where+   foldMap = foldMapDefault+++instance Traversable Horizontal where+   traverse f (Horizontal a b) = liftA2 Horizontal (f a) (f b)++instance Traversable Vertical where+   traverse f (Vertical a b) = liftA2 Vertical (f a) (f b)++instance Traversable Parts where+   traverse f (Parts a b) = liftA2 Parts (traverse f a) (traverse f b)+++instance Applicative Horizontal where+   pure a = Horizontal a a+   Horizontal fa fb <*> Horizontal a b =+      Horizontal (fa a) (fb b)++instance Applicative Vertical where+   pure a = Vertical a a+   Vertical fa fb <*> Vertical a b =+      Vertical (fa a) (fb b)++instance Applicative Parts where+   pure a = Parts (pure a) (pure a)+   Parts fa fb <*> Parts a b =+      Parts (fa <*> a) (fb <*> b)+++simple :: Parts Bool -> Char+simple set =+   case set of+      Parts (Vertical False False) (Horizontal False False) -> ' '+      Parts (Vertical False False) (Horizontal True  True ) -> '\x2500'+      Parts (Vertical True  True ) (Horizontal False False) -> '\x2502'+      Parts (Vertical True  True ) (Horizontal True  True ) -> '\x253C'++      Parts (Vertical False False) (Horizontal False True ) -> '\x2576'+      Parts (Vertical False False) (Horizontal True  False) -> '\x2574'+      Parts (Vertical False True ) (Horizontal False False) -> '\x2577'+      Parts (Vertical True  False) (Horizontal False False) -> '\x2575'++      Parts (Vertical False True ) (Horizontal False True ) -> '\x250C'+      Parts (Vertical False True ) (Horizontal True  False) -> '\x2510'+      Parts (Vertical True  False) (Horizontal False True ) -> '\x2514'+      Parts (Vertical True  False) (Horizontal True  False) -> '\x2518'++      Parts (Vertical True  True ) (Horizontal False True ) -> '\x251C'+      Parts (Vertical True  True ) (Horizontal True  False) -> '\x2524'+      Parts (Vertical False True ) (Horizontal True  True ) -> '\x252C'+      Parts (Vertical True  False) (Horizontal True  True ) -> '\x2534'+++data Weight = Empty | Light | Heavy+   deriving (Eq, Ord, Show, Enum, Bounded)++weighted :: Parts Weight -> Char+weighted set =+   case set of+      Parts (Vertical Empty Empty) (Horizontal Empty Empty) -> ' '+      Parts (Vertical Empty Empty) (Horizontal Light Light) -> '\x2500'+      Parts (Vertical Empty Empty) (Horizontal Heavy Heavy) -> '\x2501'+      Parts (Vertical Light Light) (Horizontal Empty Empty) -> '\x2502'+      Parts (Vertical Heavy Heavy) (Horizontal Empty Empty) -> '\x2503'+      Parts (Vertical Empty Light) (Horizontal Empty Light) -> '\x250C'+      Parts (Vertical Empty Light) (Horizontal Empty Heavy) -> '\x250D'+      Parts (Vertical Empty Heavy) (Horizontal Empty Light) -> '\x250E'+      Parts (Vertical Empty Heavy) (Horizontal Empty Heavy) -> '\x250F'+      Parts (Vertical Empty Light) (Horizontal Light Empty) -> '\x2510'+      Parts (Vertical Empty Light) (Horizontal Heavy Empty) -> '\x2511'+      Parts (Vertical Empty Heavy) (Horizontal Light Empty) -> '\x2512'+      Parts (Vertical Empty Heavy) (Horizontal Heavy Empty) -> '\x2513'+      Parts (Vertical Light Empty) (Horizontal Empty Light) -> '\x2514'+      Parts (Vertical Light Empty) (Horizontal Empty Heavy) -> '\x2515'+      Parts (Vertical Heavy Empty) (Horizontal Empty Light) -> '\x2516'+      Parts (Vertical Heavy Empty) (Horizontal Empty Heavy) -> '\x2517'+      Parts (Vertical Light Empty) (Horizontal Light Empty) -> '\x2518'+      Parts (Vertical Light Empty) (Horizontal Heavy Empty) -> '\x2519'+      Parts (Vertical Heavy Empty) (Horizontal Light Empty) -> '\x251A'+      Parts (Vertical Heavy Empty) (Horizontal Heavy Empty) -> '\x251B'+      Parts (Vertical Light Light) (Horizontal Empty Light) -> '\x251C'+      Parts (Vertical Light Light) (Horizontal Empty Heavy) -> '\x251D'+      Parts (Vertical Heavy Light) (Horizontal Empty Light) -> '\x251E'+      Parts (Vertical Light Heavy) (Horizontal Empty Light) -> '\x251F'+      Parts (Vertical Heavy Heavy) (Horizontal Empty Light) -> '\x2520'+      Parts (Vertical Heavy Light) (Horizontal Empty Heavy) -> '\x2521'+      Parts (Vertical Light Heavy) (Horizontal Empty Heavy) -> '\x2522'+      Parts (Vertical Heavy Heavy) (Horizontal Empty Heavy) -> '\x2523'+      Parts (Vertical Light Light) (Horizontal Light Empty) -> '\x2524'+      Parts (Vertical Light Light) (Horizontal Heavy Empty) -> '\x2525'+      Parts (Vertical Heavy Light) (Horizontal Light Empty) -> '\x2526'+      Parts (Vertical Light Heavy) (Horizontal Light Empty) -> '\x2527'+      Parts (Vertical Heavy Heavy) (Horizontal Light Empty) -> '\x2528'+      Parts (Vertical Heavy Light) (Horizontal Heavy Empty) -> '\x2529'+      Parts (Vertical Light Heavy) (Horizontal Heavy Empty) -> '\x252A'+      Parts (Vertical Heavy Heavy) (Horizontal Heavy Empty) -> '\x252B'+      Parts (Vertical Empty Light) (Horizontal Light Light) -> '\x252C'+      Parts (Vertical Empty Light) (Horizontal Heavy Light) -> '\x252D'+      Parts (Vertical Empty Light) (Horizontal Light Heavy) -> '\x252E'+      Parts (Vertical Empty Light) (Horizontal Heavy Heavy) -> '\x252F'+      Parts (Vertical Empty Heavy) (Horizontal Light Light) -> '\x2530'+      Parts (Vertical Empty Heavy) (Horizontal Heavy Light) -> '\x2531'+      Parts (Vertical Empty Heavy) (Horizontal Light Heavy) -> '\x2532'+      Parts (Vertical Empty Heavy) (Horizontal Heavy Heavy) -> '\x2533'+      Parts (Vertical Light Empty) (Horizontal Light Light) -> '\x2534'+      Parts (Vertical Light Empty) (Horizontal Heavy Light) -> '\x2535'+      Parts (Vertical Light Empty) (Horizontal Light Heavy) -> '\x2536'+      Parts (Vertical Light Empty) (Horizontal Heavy Heavy) -> '\x2537'+      Parts (Vertical Heavy Empty) (Horizontal Light Light) -> '\x2538'+      Parts (Vertical Heavy Empty) (Horizontal Heavy Light) -> '\x2539'+      Parts (Vertical Heavy Empty) (Horizontal Light Heavy) -> '\x253A'+      Parts (Vertical Heavy Empty) (Horizontal Heavy Heavy) -> '\x253B'+      Parts (Vertical Light Light) (Horizontal Light Light) -> '\x253C'+      Parts (Vertical Light Light) (Horizontal Heavy Light) -> '\x253D'+      Parts (Vertical Light Light) (Horizontal Light Heavy) -> '\x253E'+      Parts (Vertical Light Light) (Horizontal Heavy Heavy) -> '\x253F'+      Parts (Vertical Heavy Light) (Horizontal Light Light) -> '\x2540'+      Parts (Vertical Light Heavy) (Horizontal Light Light) -> '\x2541'+      Parts (Vertical Heavy Heavy) (Horizontal Light Light) -> '\x2542'+      Parts (Vertical Heavy Light) (Horizontal Heavy Light) -> '\x2543'+      Parts (Vertical Heavy Light) (Horizontal Light Heavy) -> '\x2544'+      Parts (Vertical Light Heavy) (Horizontal Heavy Light) -> '\x2545'+      Parts (Vertical Light Heavy) (Horizontal Light Heavy) -> '\x2546'+      Parts (Vertical Heavy Light) (Horizontal Heavy Heavy) -> '\x2547'+      Parts (Vertical Light Heavy) (Horizontal Heavy Heavy) -> '\x2548'+      Parts (Vertical Heavy Heavy) (Horizontal Heavy Light) -> '\x2549'+      Parts (Vertical Heavy Heavy) (Horizontal Light Heavy) -> '\x254A'+      Parts (Vertical Heavy Heavy) (Horizontal Heavy Heavy) -> '\x254B'+      Parts (Vertical Empty Empty) (Horizontal Light Empty) -> '\x2574'+      Parts (Vertical Light Empty) (Horizontal Empty Empty) -> '\x2575'+      Parts (Vertical Empty Empty) (Horizontal Empty Light) -> '\x2576'+      Parts (Vertical Empty Light) (Horizontal Empty Empty) -> '\x2577'+      Parts (Vertical Empty Empty) (Horizontal Heavy Empty) -> '\x2578'+      Parts (Vertical Heavy Empty) (Horizontal Empty Empty) -> '\x2579'+      Parts (Vertical Empty Empty) (Horizontal Empty Heavy) -> '\x257A'+      Parts (Vertical Empty Heavy) (Horizontal Empty Empty) -> '\x257B'+      Parts (Vertical Empty Empty) (Horizontal Light Heavy) -> '\x257C'+      Parts (Vertical Light Heavy) (Horizontal Empty Empty) -> '\x257D'+      Parts (Vertical Empty Empty) (Horizontal Heavy Light) -> '\x257E'+      Parts (Vertical Heavy Light) (Horizontal Empty Empty) -> '\x257F'+++data Directions a = Directions {vertical, horizontal :: a} deriving (Eq, Show)++instance Functor Directions where+   fmap f (Directions a b) = Directions (f a) (f b)++instance Foldable Directions where+   foldMap = foldMapDefault++instance Traversable Directions where+   traverse f (Directions a b) = liftA2 Directions (f a) (f b)++instance Applicative Directions where+   pure a = Directions a a+   Directions fa fb <*> Directions a b =+      Directions (fa a) (fb b)+++{- |+This function is not total because half-width and half-height double bars are missing.+-}+double :: Directions Bool -> Parts Bool -> Char+double doubled set =+   maybe (error "Frame.double: frame character not available") id $+   doubleMaybe doubled set++doubleMaybe :: Directions Bool -> Parts Bool -> Maybe Char+doubleMaybe doubled set =+   let adapt base =+          Just $+          case doubled of+             Directions False False -> simple set+             Directions False True -> base+             Directions True False -> succ base+             Directions True True -> succ $ succ base+   in  case (doubled, set) of+          (Directions _ _,     Parts (Vertical False False) (Horizontal False False)) -> Just ' '+          (Directions _ False, Parts (Vertical False False) (Horizontal True  True )) -> Just '\x2500'+          (Directions False _, Parts (Vertical True  True ) (Horizontal False False)) -> Just '\x2502'++          (Directions _ True, Parts (Vertical False False) (Horizontal True  True )) -> Just '\x2550'+          (Directions True _, Parts (Vertical True  True ) (Horizontal False False)) -> Just '\x2551'++          (Directions _ False, Parts (Vertical False False) (Horizontal True  False)) -> Just '\x2574'+          (Directions False _, Parts (Vertical True  False) (Horizontal False False)) -> Just '\x2575'+          (Directions _ False, Parts (Vertical False False) (Horizontal False True )) -> Just '\x2576'+          (Directions False _, Parts (Vertical False True ) (Horizontal False False)) -> Just '\x2577'++          (Directions _ True, Parts (Vertical False False) (Horizontal False True )) -> Nothing+          (Directions True _, Parts (Vertical True  False) (Horizontal False False)) -> Nothing+          (Directions _ True, Parts (Vertical False False) (Horizontal True  False)) -> Nothing+          (Directions True _, Parts (Vertical False True ) (Horizontal False False)) -> Nothing++          (_, Parts (Vertical False True) (Horizontal False True)) -> adapt '\x2552'+          (_, Parts (Vertical False True) (Horizontal True False)) -> adapt '\x2555'+          (_, Parts (Vertical True False) (Horizontal False True)) -> adapt '\x2558'+          (_, Parts (Vertical True False) (Horizontal True False)) -> adapt '\x255B'+          (_, Parts (Vertical True True) (Horizontal False True)) -> adapt '\x255E'+          (_, Parts (Vertical True True) (Horizontal True False)) -> adapt '\x2561'+          (_, Parts (Vertical False True) (Horizontal True True)) -> adapt '\x2564'+          (_, Parts (Vertical True False) (Horizontal True True)) -> adapt '\x2567'+          (_, Parts (Vertical True True) (Horizontal True True)) -> adapt '\x256A'+
+ src/Data/Char/Number.hs view
@@ -0,0 +1,29 @@+module Data.Char.Number where++import qualified Data.Map as Map+import Data.Map (Map)+++fractionMap :: (Ord a, Fractional a) => Map a Char+fractionMap =+   Map.fromList $+      (1/4, '\xbc') :+      (1/2, '\xbd') :+      (3/4, '\xbe') :+      (1/7, '\x2150') :+      (1/9, '\x2151') :+      (1/10,'\x2152') :+      (1/3, '\x2153') :+      (2/3, '\x2154') :+      (1/5, '\x2155') :+      (2/5, '\x2156') :+      (3/5, '\x2157') :+      (4/5, '\x2158') :+      (1/6, '\x2159') :+      (5/6, '\x215A') :+      (1/8, '\x215B') :+      (3/8, '\x215C') :+      (5/8, '\x215D') :+      (7/8, '\x215E') :+      []+
+ src/Data/Char/Small.hs view
@@ -0,0 +1,75 @@+module Data.Char.Small where++{- | non-total function -}+superscript :: Char -> Char+superscript =+   maybe (error "no superscript character available") id .+   superscriptMaybe++superscriptMaybe :: Char -> Maybe Char+superscriptMaybe c =+   case c of+      '0' -> Just '\x2070'+      '1' -> Just '\xb9'+      '2' -> Just '\xb2'+      '3' -> Just '\xb3'+      '4' -> Just '\x2074'+      '5' -> Just '\x2075'+      '6' -> Just '\x2076'+      '7' -> Just '\x2077'+      '8' -> Just '\x2078'+      '9' -> Just '\x2079'++      '+' -> Just '\x207A'+      '-' -> Just '\x207B'+      '=' -> Just '\x207C'+      '(' -> Just '\x207D'+      ')' -> Just '\x207E'++      'i' -> Just '\x2071'+      'n' -> Just '\x207F'++      _ -> Nothing+++{- | non-total function -}+subscript :: Char -> Char+subscript =+   maybe (error "no subscript character available") id .+   subscriptMaybe++subscriptMaybe :: Char -> Maybe Char+subscriptMaybe c =+   case c of+      '0' -> Just '\x2080'+      '1' -> Just '\x2081'+      '2' -> Just '\x2082'+      '3' -> Just '\x2083'+      '4' -> Just '\x2084'+      '5' -> Just '\x2085'+      '6' -> Just '\x2086'+      '7' -> Just '\x2087'+      '8' -> Just '\x2088'+      '9' -> Just '\x2089'++      '+' -> Just '\x208A'+      '-' -> Just '\x208B'+      '=' -> Just '\x208C'+      '(' -> Just '\x208D'+      ')' -> Just '\x208E'++      'a' -> Just '\x2090'+      'e' -> Just '\x2091'+      'o' -> Just '\x2092'+      'x' -> Just '\x2093'++      'h' -> Just '\x2095'+      'k' -> Just '\x2096'+      'l' -> Just '\x2097'+      'm' -> Just '\x2098'+      'n' -> Just '\x2099'+      'p' -> Just '\x209A'+      's' -> Just '\x209B'+      't' -> Just '\x209C'++      _ -> Nothing
+ test/Test.hs view
@@ -0,0 +1,9 @@+module Main where++import qualified Test.Data.Char.Block as Block+import qualified Test.Data.Char.Frame as Frame++main :: IO ()+main = do+   Block.test+   Frame.test
+ test/Test/Data/Char/Block.hs view
@@ -0,0 +1,14 @@+module Test.Data.Char.Block where++import Test.Utility (checkDuplicates, )++import qualified Data.Char.Block as Block++import Control.Applicative (pure, )+import Data.Traversable (sequenceA, )+++test :: IO ()+test = do+   putStrLn "Check duplicates of block graphics"+   checkDuplicates (sequenceA $ pure [False, True]) Block.filled
+ test/Test/Data/Char/Frame.hs view
@@ -0,0 +1,51 @@+module Test.Data.Char.Frame where++import Test.Utility (checkDuplicates, )++import qualified Data.Char.Frame as Frame++import qualified System.Exit as Exit+import qualified System.IO as IO++import qualified Data.List.HT as ListHT+import qualified Data.Foldable as Fold+import Control.Monad (when, )+import Control.Applicative (pure, )+import Data.Traversable (sequenceA, )+++allParts :: [Frame.Parts Bool]+allParts = sequenceA $ pure [False, True]++longParts :: [Frame.Parts Bool]+longParts = filter (ListHT.lengthAtLeast 2 . filter id . Fold.toList) allParts++weightFromBool :: Bool -> Frame.Weight+weightFromBool b =+   if b then Frame.Light else Frame.Empty++checkMatches :: (Frame.Parts Bool -> Char) -> IO ()+checkMatches f = do+   let mismatches =+          filter (uncurry (/=) . snd) $+          map (\parts -> (parts, (Frame.simple parts, f parts))) $+          allParts+   when (not $ null mismatches) $ do+      IO.hPutStrLn IO.stderr "mismatches:"+      mapM_ (IO.hPrint IO.stderr) mismatches+      Exit.exitFailure++test :: IO ()+test = do+   putStrLn "Check consistency of weighted frame elements"+   checkMatches (Frame.weighted . fmap weightFromBool)++   putStrLn "Check consistency of double frame elements"+   checkMatches (Frame.double (Frame.Directions False False))++   putStrLn "Check duplicates of weighted frame elements"+   checkDuplicates (sequenceA $ pure [minBound .. maxBound]) Frame.weighted++   Fold.forM_ (sequenceA $ pure [False, True]) $ \dir -> do+      putStrLn ("Check duplicates of double frame elements, " ++ show dir)+      checkDuplicates longParts (Frame.double dir)
+ test/Test/Utility.hs view
@@ -0,0 +1,22 @@+module Test.Utility where++import qualified System.Exit as Exit+import qualified System.IO as IO++import qualified Data.List.HT as ListHT+import qualified Data.Map as Map++import Control.Monad (when, )+++checkDuplicates :: (Show a) => [a] -> (a -> Char) -> IO ()+checkDuplicates xs f = do+   let duplicates =+          Map.toList $+          Map.filter (ListHT.lengthAtLeast 2) $+          Map.fromListWith (++) $+          map (\x -> (f x, [x])) xs+   when (not $ null duplicates) $ do+      IO.hPutStrLn IO.stderr "duplicates:"+      mapM_ (IO.hPrint IO.stderr) duplicates+      Exit.exitFailure
+ unicode.cabal view
@@ -0,0 +1,90 @@+Name:             unicode+Version:          0.0+License:          BSD3+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://code.haskell.org/~thielema/unicode/+Category:         Text+Synopsis:         Construct and transform unicode characters+Description:+  The package contains functions for construction+  of various characters like:+  .+  * block graphic elements+  .+  * frame elements+  .+  * fractions+  .+  * subscript and superscript characters+  .+  Related packages:+  .+  * @unicode-properties@: classifications such as lower case, graphical etc.+  .+  * @rfc5051@: sorting of characters++Tested-With:      GHC==7.4.1+Cabal-Version:    >=1.8+Build-Type:       Simple++Flag buildExamples+  description: Build example executables+  default:     False++Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/unicode/++Source-Repository head+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/unicode/++Library+  Build-Depends:+    containers >=0.4 && <0.6,+    base >=4 && <5++  GHC-Options:      -Wall+  Hs-Source-Dirs:   src+  Exposed-Modules:+    Data.Char.Block+    Data.Char.Frame+    Data.Char.Number+    Data.Char.Small++Executable visualize-unicode+  If flag(buildExamples)+    Build-Depends:+      unicode,+      containers,+      utility-ht >=0.0.1 && <0.1,+      base+  Else+    Buildable: False+  Main-Is:          Visualize.hs+  GHC-Options:      -Wall+  Hs-source-dirs:   vis+  Other-Modules:+    Visualize.Data.Char.Block+    Visualize.Data.Char.Frame+    Visualize.Data.Char.Number+    Visualize.Data.Char.Small+    Visualize.Utility++Test-Suite test+  Type: exitcode-stdio-1.0+  Build-Depends:+    unicode,+    containers,+    utility-ht >=0.0.1 && <0.1,+    base+  Main-Is:          Test.hs+  GHC-Options:      -Wall+  Hs-source-dirs:   test+  Other-Modules:+    Test.Data.Char.Block+    Test.Data.Char.Frame+    Test.Utility
+ vis/Visualize.hs view
@@ -0,0 +1,14 @@+module Main where++import qualified Visualize.Data.Char.Block as Block+import qualified Visualize.Data.Char.Frame as Frame+import qualified Visualize.Data.Char.Number as Number+import qualified Visualize.Data.Char.Small as Small+++main :: IO ()+main = do+   Block.visualize+   Frame.visualize+   Number.visualize+   Small.visualize
+ vis/Visualize/Data/Char/Block.hs view
@@ -0,0 +1,29 @@+module Visualize.Data.Char.Block where++import Visualize.Utility (printGrid, )++import qualified Data.Char.Block as Block++import Control.Applicative (pure, )+import Data.Traversable (sequenceA, )+++{-+I would like to have a table with a symmetry+with respect to the diagonal to the right lower corner.+Unfortunately this is not possible.+A symbol that is symmetric with respect to this diagonal+must be placed on the diagonal of the table.+This diagonal consists of 4 symbols,+but there are 8 symmetric symbols.+These symmetric symbols can be constructed+by conditionally merging three symmetric basis symbols,+namely 'left upper block', 'right lower block',+'left lower and right upper block'.+-}+visualize :: IO ()+visualize = do+   printGrid+      (\r0 r1 -> Block.filled $ Block.Block r0 r1)+      (sequenceA $ pure [False, True])+      (sequenceA $ pure [False, True])
+ vis/Visualize/Data/Char/Frame.hs view
@@ -0,0 +1,30 @@+module Visualize.Data.Char.Frame where++import Visualize.Utility (printGrid, )++import qualified Data.Char.Frame as Frame++import Control.Applicative (pure, liftA2, )+import Data.Traversable (sequenceA, )+++visualize :: IO ()+visualize = do+   printGrid+      (\v h -> Frame.simple $ Frame.Parts v h)+      (sequenceA $ pure [False, True])+      (sequenceA $ pure [False, True])++   printGrid+      (\(dv,v) (dh,h) ->+          maybe '?' id $+          Frame.doubleMaybe (Frame.Directions dv dh) (Frame.Parts v h))+      (liftA2 (,)+          [False, True] (sequenceA $ pure [minBound .. maxBound]))+      (liftA2 (,)+          [False, True] (sequenceA $ pure [minBound .. maxBound]))++   printGrid+      (\v h -> Frame.weighted $ Frame.Parts v h)+      (sequenceA $ pure [minBound .. maxBound])+      (sequenceA $ pure [minBound .. maxBound])
+ vis/Visualize/Data/Char/Number.hs view
@@ -0,0 +1,12 @@+module Visualize.Data.Char.Number where++import qualified Data.Char.Number as Number+import qualified Data.Map as Map+++visualize :: IO ()+visualize = do+   putStrLn $ unlines $ Map.elems $+      Map.mapWithKey+         (\ratio chr -> show (ratio::Rational) ++ '\t' : chr : [])+         Number.fractionMap
+ vis/Visualize/Data/Char/Small.hs view
@@ -0,0 +1,15 @@+module Visualize.Data.Char.Small where++import qualified Data.Char.Small as Small++import Data.Foldable (forM_, )+++visualize :: IO ()+visualize = do+   forM_ ['\32' .. '\127'] $ \c ->+      case (Small.superscriptMaybe c, Small.subscriptMaybe c) of+         (Nothing, Nothing) -> return ()+         (super, sub) ->+            putStrLn $+               c : ' ' : maybe ' ' id super : ' ' : maybe ' ' id sub : []
+ vis/Visualize/Utility.hs view
@@ -0,0 +1,10 @@+module Visualize.Utility where++import qualified Data.List.HT as ListHT+import Data.List (intersperse, )+++printGrid :: (a -> b -> Char) -> [a] -> [b] -> IO ()+printGrid f as bs =+   putStrLn $ unlines $ intersperse "" $ map (intersperse ' ') $+      ListHT.outerProduct f as bs