diff --git a/patch-image.cabal b/patch-image.cabal
--- a/patch-image.cabal
+++ b/patch-image.cabal
@@ -1,5 +1,5 @@
 Name:           patch-image
-Version:        0.3.3
+Version:        0.3.3.1
 License:        BSD3
 License-File:   LICENSE
 Author:         Henning Thielemann <haskell@henning-thielemann.de>
@@ -33,7 +33,7 @@
   * Images must be approximately correctly oriented.
   .
   * May have problems with unstructured areas in the image.
-Tested-With:    GHC==7.8.3
+Tested-With:    GHC==7.8.4, GHC==8.2.2
 Cabal-Version:  >=1.6
 Build-Type:     Simple
 Extra-Source-Files:
@@ -41,7 +41,7 @@
   README.md
 
 Source-Repository this
-  Tag:         0.3.3
+  Tag:         0.3.3.1
   Type:        darcs
   Location:    http://hub.darcs.net/thielema/patch-image/
 
@@ -56,6 +56,7 @@
 
 Flag cuda
   Description: Build program version base on accelerate-cuda
+  Default:     False
   Manual:      True
 
 Flag buildDraft
@@ -69,12 +70,12 @@
     MatchImageBorders
     Knead.CArray
     Knead.Shape
+    Knead.Color
     Complex
     State
     LinearAlgebra
     Arithmetic
     Degree
-    Option.Utility
     Option
   Hs-Source-Dirs: src
 
@@ -83,29 +84,29 @@
 
   If flag(llvm)
     Build-Depends:
-      knead >=0.4 && <0.5,
-      llvm-extra >=0.8 && <0.9,
-      llvm-tf >=3.1 && <3.2,
+      knead >=0.4 && <0.6,
+      llvm-extra >=0.10 && <0.11,
+      llvm-tf >=9.2 && <9.3,
       tfp >=1.0 && <1.1,
       comfort-array >=0.3 && <0.5,
       JuicyPixels >=2.0 && <3.4,
       dsp >=0.2.4 && <0.3,
       vector >=0.10 && <0.13,
       pqueue >=1.2 && <1.5,
-      enumset >=0.0.4 && <0.1,
+      enumset >=0.0.5 && <0.1,
       containers >=0.4.2 && <0.7,
       semigroups >=0.1 && <1.0,
       fft >=0.1.7 && <0.2,
       storable-complex >=0.2.2 && <0.3,
-      storable-tuple >=0.0.3 && <0.1,
+      storable-record >=0.0.5 && <0.1,
       bool8 >=0.0 && <0.1,
       carray >=0.1.5 && <0.2,
       array >=0.4 && <0.6,
-      cassava >=0.4.5 && <0.5.2,
-      unordered-containers >=0.2.5 && <0.2.10,
+      cassava >=0.4.5 && <0.6,
+      unordered-containers >=0.2.5 && <0.2.11,
       bytestring >=0.9.2 && <0.11,
       explicit-exception >=0.1.7 && <0.2,
-      Cabal >=1.18 && <3,
+      shell-utility >=0.1 && <0.2,
       filepath >=1.3 && <1.5,
       non-empty >=0.2 && <0.4,
       utility-ht >=0.0.13 && <0.1,
@@ -122,7 +123,6 @@
     Arithmetic
     Complex
     Degree
-    Option.Utility
     Option
   Hs-Source-Dirs: src
 
@@ -139,17 +139,17 @@
       accelerate-io >=1.0 && <1.1,
       accelerate >=1.1 && <1.2,
       JuicyPixels >=2.0 && <3.4,
-      cassava >=0.4.5 && <0.5.2,
+      cassava >=0.4.5 && <0.6,
       dsp >=0.2.4 && <0.3,
       gnuplot >=0.5 && <0.6,
       containers >=0.4.2 && <0.7,
       array >=0.4 && <0.6,
       vector >=0.10 && <0.13,
-      unordered-containers >=0.2.5 && <0.2.10,
+      unordered-containers >=0.2.5 && <0.2.11,
       bytestring >=0.9.2 && <0.11,
-      enumset >=0.0.4 && <0.1,
+      enumset >=0.0.5 && <0.1,
       explicit-exception >=0.1.7 && <0.2,
-      Cabal >=1.18 && <3,
+      shell-utility >=0.1 && <0.2,
       filepath >=1.3 && <1.5,
       non-empty >=0.2 && <0.4,
       utility-ht >=0.0.1 && <0.1,
diff --git a/src/Accelerate.hs b/src/Accelerate.hs
--- a/src/Accelerate.hs
+++ b/src/Accelerate.hs
@@ -63,9 +63,9 @@
 import qualified System.FilePath as FilePath
 import qualified System.IO as IO
 
-import qualified Distribution.Simple.Utils as CmdLine
-import qualified Distribution.Verbosity as Verbosity
-import Distribution.Verbosity (Verbosity)
+import qualified Shell.Utility.Log as CmdLine
+import qualified Shell.Utility.Verbosity as Verbosity
+import Shell.Utility.Verbosity (Verbosity)
 import Text.Printf (printf)
 
 import Control.Monad.HT (void)
@@ -1493,10 +1493,10 @@
    let (poss, dps) =
           absolutePositionsFromPairDisplacements
              (fixAtLeastOnePosition (0,0) $ map picParam pics) overlaps
-   info "\nabsolute positions"
+   info "\nabsolute positions\n"
    info $ unlines $ map show poss
 
-   info "\ncompare position differences with pair displacements"
+   info "\ncompare position differences with pair displacements\n"
    info $ unlines $
       zipWith
          (\(dpx,dpy) (dx,dy) ->
@@ -1569,11 +1569,11 @@
                            (\(score,pa,pb) ->
                               (score, (add pa leftTopA, add pb leftTopB))) $
                         optimalOverlapShared mMaxDiff picA picB
-                  info $ printf "left-top: %s, %s" (show leftTopA) (show leftTopB)
-                  info $ printf "%s - %s" pathA pathB
+                  info $ printf "left-top: %s, %s\n" (show leftTopA) (show leftTopB)
+                  info $ printf "%s - %s\n" pathA pathB
                   forM_ corrs $ \(score, (pa@(xa,ya),pb@(xb,yb))) ->
                      info $
-                        printf "%s ~ %s, (%f,%f), %f"
+                        printf "%s ~ %s, (%f,%f), %f\n"
                            (show pa) (show pb) (xb-xa) (yb-ya) score
                   return $ map snd corrs
          return ((ia,ib), (pathA,pathB), correspondences)
@@ -1588,7 +1588,7 @@
               fixAtLeastOneAnglePosition (Degree 0, (0,0)) $
               map picParam pics)
              overlaps
-   info "\nabsolute positions and rotations: place, rotation (magnitude, phase)"
+   info "\nabsolute positions and rotations: place, rotation (magnitude, phase)\n"
    infoPlain $ unlines $
       map
          (\((dx,dy),r) ->
@@ -1598,7 +1598,7 @@
                (getDegree $ Degree.fromRadian $ Complex.phase r))
          posRots
 
-   info "\ncompare position differences with pair displacements"
+   info "\ncompare position differences with pair displacements\n"
    infoPlain $ unlines $
       zipWith
          (\(dpx,dpy) (_i, ((xa,ya),(xb,yb))) ->
@@ -1619,7 +1619,7 @@
 
    inputs <- Option.images args
 
-   notice "\nfind rotation angles"
+   notice "\nfind rotation angles\n"
    picAngles <-
       forM inputs $ \(State.Proposed path (maybeAngle, _) _) -> do
          pic <- readImage (Option.verbosity opt) path
@@ -1641,7 +1641,7 @@
       State.write (printf format "angle") $
          zipWith State.Angle (map State.propPath inputs) (map fst picAngles)
 
-   notice "\nfind relative placements"
+   notice "\nfind relative placements\n"
    let rotated = map (prepareOverlapMatching (Option.smooth opt)) picAngles
 
    when False $ do
@@ -1687,7 +1687,7 @@
                (angle <> Degree.fromRadian (Complex.phase rot)) pos)
          paths picAngles posRots
 
-   notice "\ncompose all parts"
+   notice "\ncompose all parts\n"
    let ((canvasWidth, canvasHeight), rotMovPics, canvasMsgs) =
          Arith.canvasShape colorImageExtent
             (map (mapFst Degree.toRadian) picAngles) posRots
@@ -1701,7 +1701,7 @@
          (emptyCountCanvas (Z :. 3 :. canvasHeight :. canvasWidth))
          rotMovPics
 
-   notice "\ndistance maps"
+   notice "\ndistance maps\n"
    let geometryRelations =
          Arith.geometryRelations $
          map (Arith.geometryFeatures . mapThd3 colorImageExtent) rotMovPics
@@ -1729,7 +1729,7 @@
             distanceMapRun canvasShape thisGeom otherGeoms allPoints
 
    forM_ (Option.output opt) $ \path -> do
-     notice "\nweighted composition"
+     notice "\nweighted composition\n"
      writeImage (Option.quality opt) path $
       finalizeWeightedCanvas $
       foldl
diff --git a/src/Knead.hs b/src/Knead.hs
--- a/src/Knead.hs
+++ b/src/Knead.hs
@@ -7,6 +7,7 @@
 import qualified MatchImageBorders
 import qualified Arithmetic as Arith
 import qualified Knead.CArray as KneadCArray
+import qualified Knead.Color as Color
 import qualified Complex as Komplex
 import qualified Degree
 import MatchImageBorders (arrayPairFromVec, arrayVecFromPair)
@@ -19,6 +20,7 @@
 import Knead.Shape
          (Size, Vec2(Vec2), Dim1, Dim2, Shape2, Shape2ZB, Index2, Ix2, Factor2,
           verticalSize, verticalVal, horizontalVal)
+import Knead.Color (YUV)
 import Degree (Degree(Degree), getDegree)
 
 import qualified Math.FFT as FFT
@@ -38,10 +40,11 @@
 import qualified Data.Array.Comfort.Storable.Unchecked as ComfortArray
 import qualified Data.Array.Comfort.Shape as ComfortShape
 
+import qualified LLVM.Extra.Multi.Value as MultiValue
 import qualified LLVM.Extra.ScalarOrVector as SoV
 import qualified LLVM.Extra.Arithmetic as LLVMArith
-import qualified LLVM.Extra.Multi.Value.Memory as MultiMem
-import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.Storable as Storable
+import qualified LLVM.Extra.Tuple as Tuple
 import LLVM.Extra.Multi.Value (Atom, atom)
 
 import qualified LLVM.Core as LLVM
@@ -53,19 +56,20 @@
 
 import qualified Data.Vector.Storable as SV
 import Foreign.ForeignPtr (ForeignPtr, castForeignPtr)
+import Foreign.Storable.Record.Tuple (Tuple(Tuple, getTuple))
 import Foreign.Storable.Complex ()
 
 import qualified System.FilePath as FilePath
 import qualified System.IO as IO
 
-import qualified Distribution.Simple.Utils as CmdLine
-import qualified Distribution.Verbosity as Verbosity
-import Distribution.Verbosity (Verbosity)
+import qualified Shell.Utility.Log as CmdLine
+import qualified Shell.Utility.Verbosity as Verbosity
+import Shell.Utility.Verbosity (Verbosity)
 import Text.Printf (printf)
 
 import qualified Control.Monad.HT as MonadHT
 import Control.Monad (when, join, foldM, (<=<))
-import Control.Applicative (pure, (<$>), (<*>))
+import Control.Applicative (liftA2, pure, (<$>), (<*>))
 
 import qualified Data.Foldable as Fold
 import qualified Data.List as List
@@ -79,7 +83,7 @@
 import Data.Foldable (forM_)
 import Data.Ord.HT (comparing)
 import Data.Tuple.HT
-         (mapPair, mapFst, mapSnd, mapTriple, swap, mapThd3, fst3, uncurry3)
+         (mapPair, mapFst, mapSnd, mapTriple, swap, mapThd3, uncurry3)
 import Data.Word (Word8, Word32)
 import Data.Bool8 (Bool8)
 
@@ -92,11 +96,11 @@
 type SmallDim = Shape.ZeroBased SmallSize
 
 type Plane = Phys.Array Dim2
+type Planes tuple = Plane (Tuple tuple)
 type SymbPlane = Symb.Array Dim2
 type ColorImage a = Phys.Array Dim2 (YUV a)
 type ColorImage8 = ColorImage Word8
 
-type YUV a = (a,a,a)
 
 shape2 :: (Integral i) => i -> i -> Dim2
 shape2 height width =
@@ -200,27 +204,23 @@
 
 
 yuvByteFromFloat ::
-   (MultiValue.NativeFloating a ar,
+   (MultiValue.NativeFloating a ar, a ~ ar,
     MultiValue.Field a, MultiValue.Real a,
     MultiValue.RationalConstant a) =>
    Exp (YUV a) -> Exp (YUV Word8)
-yuvByteFromFloat =
-   Expr.modify (atom,atom,atom) $
-      mapTriple (byteFromFloat, byteFromFloat, byteFromFloat)
+yuvByteFromFloat = Color.map byteFromFloat
 
 colorImageFloatFromByte ::
    (Symb.C array, Shape.C sh,
-    MultiValue.NativeFloating a ar,
+    MultiValue.NativeFloating a ar, a ~ ar,
     MultiValue.PseudoRing a, MultiValue.Real a,
     MultiValue.RationalConstant a) =>
    array sh (YUV Word8) -> array sh (YUV a)
-colorImageFloatFromByte =
-   Symb.map $ Expr.modify (atom,atom,atom) $
-      mapTriple (floatFromByte, floatFromByte, floatFromByte)
+colorImageFloatFromByte = Symb.map $ Color.map floatFromByte
 
 colorImageByteFromFloat ::
    (Symb.C array, Shape.C sh,
-    MultiValue.NativeFloating a ar,
+    MultiValue.NativeFloating a ar, a ~ ar,
     MultiValue.Field a, MultiValue.Real a,
     MultiValue.RationalConstant a) =>
    array sh (YUV a) -> array sh (YUV Word8)
@@ -307,17 +307,15 @@
 
 type VecExp a v = Arith.Vec (Exp a) (Exp v)
 
-vecYUV :: (MultiValue.PseudoRing a) => VecExp a (YUV a)
+vecYUV ::
+   (MultiValue.PseudoRing a, LLVM.IsArithmetic a,
+    LLVM.IsPrimitive a, LLVM.IsConst a, Tuple.ValueOf a ~ LLVM.Value a) =>
+   VecExp a (YUV a)
 vecYUV =
    Arith.Vec {
-      Arith.vecZero = Expr.compose (Expr.zero, Expr.zero, Expr.zero),
-      Arith.vecAdd =
-         Expr.modify2 (atom,atom,atom) (atom,atom,atom) $
-            \(ay,au,av) (by,bu,bv) ->
-               (Expr.add ay by, Expr.add au bu, Expr.add av bv),
-      Arith.vecScale =
-         Expr.modify2 atom (atom,atom,atom) $
-            \a (by,bu,bv) -> (Expr.mul a by, Expr.mul a bu, Expr.mul a bv)
+      Arith.vecZero = Expr.zero,
+      Arith.vecAdd = Expr.liftTupleM2 LLVMArith.add,
+      Arith.vecScale = Expr.liftTupleM2 SoV.scale
    }
 
 {-
@@ -405,7 +403,7 @@
 
 
 rotateStretchMoveCoords ::
-   (SV.Storable a, MultiMem.C a,
+   (SV.Storable a, Storable.C a,
     MultiValue.Real a, MultiValue.Field a,
     MultiValue.RationalConstant a, MultiValue.NativeFloating a ar) =>
    Exp (a, a) ->
@@ -452,7 +450,7 @@
 and then moves the picture.
 -}
 rotateStretchMove ::
-   (SV.Storable a, MultiMem.C a,
+   (SV.Storable a, Storable.C a,
     MultiValue.Real a, MultiValue.Field a,
     MultiValue.RationalConstant a, MultiValue.NativeFloating a ar,
     MultiValue.C v) =>
@@ -471,7 +469,7 @@
           Symb.map (Expr.modify (atom,atom) $ \(x,y) -> ix2 y x) coords)
 
 rotate ::
-   (SV.Storable a, MultiMem.C a,
+   (SV.Storable a, Storable.C a,
     MultiValue.Real a, MultiValue.Field a,
     MultiValue.RationalConstant a, MultiValue.NativeFloating a ar,
     MultiValue.C v) =>
@@ -498,16 +496,15 @@
    return $ \ angle img -> rot (Degree.cis angle) img
 
 
-brightnessValue :: Exp (YUV a) -> Exp a
-brightnessValue = Expr.modify (atom,atom,atom) fst3
-
 brightnessPlane ::
    (Symb.C array, Shape.C size) =>
+   (LLVM.IsPrimitive a, Tuple.ValueOf a ~ LLVM.Value a) =>
    array size (YUV a) -> array size a
-brightnessPlane = Symb.map brightnessValue
+brightnessPlane = Symb.map Color.brightness
 
 rowHistogram ::
    (Symb.C array, MultiValue.Additive a) =>
+   (LLVM.IsPrimitive a, Tuple.ValueOf a ~ LLVM.Value a) =>
    array Dim2 (YUV a) -> array Dim1 a
 rowHistogram =
    Symb.fold1 Expr.add .
@@ -613,7 +610,7 @@
       spec (cyclicReverse2d spec)
 
 correlatePadded ::
-   (FFTWReal a, MultiValue.Real a, MultiMem.C a,
+   (FFTWReal a, MultiValue.Real a, Storable.C a,
     MultiValue.Field a, MultiValue.RationalConstant a) =>
    Dim2 -> IO (Plane a -> Plane a -> IO (Plane a))
 correlatePadded
@@ -755,7 +752,7 @@
 optimalOverlap padExtent = do
    run <-
       RenderP.run $ \minOverlapPortion (sha, shb) img ->
-         argmaximum $
+         RenderP.MarshalExp $ argmaximum $
          allOverlapsFromCorrelation padExtent minOverlapPortion sha shb img
    correlate <- correlatePadded padExtent
 
@@ -1043,9 +1040,9 @@
 
 
 
-emptyCountCanvas :: IO (Dim2 -> IO (Plane (Word32, YUV Float)))
+emptyCountCanvas :: IO (Dim2 -> IO (Planes (Word32, YUV Float)))
 emptyCountCanvas =
-   RenderP.run $ \sh -> Symb.fill sh (Expr.zip 0 $ Expr.zip3 0 0 0)
+   RenderP.run $ \sh -> Symb.fill sh (Expr.tuple $ Expr.zip 0 $ Color.yuv 0 0 0)
 
 
 type RotatedImage = ((Float,Float), (Float,Float), ColorImage8)
@@ -1064,21 +1061,22 @@
           Arith.vecScale vec (Expr.floatFromBool8 mask) pic))
 
 updateCountCanvas ::
-   IO (RotatedImage -> Plane (Word32, YUV Float) ->
-       IO (Plane (Word32, YUV Float)))
+   IO (RotatedImage -> Planes (Word32, YUV Float) ->
+       IO (Planes (Word32, YUV Float)))
 updateCountCanvas =
    RenderP.run $ \(rot, mov, pic) countCanvas ->
+      Symb.map Expr.tuple $
       addToCountCanvas vecYUV
          (rotateStretchMove vecYUV rot mov (Symb.shape countCanvas) $
           colorImageFloatFromByte pic)
-         countCanvas
+         (Symb.map Expr.untuple countCanvas)
 
-finalizeCountCanvas :: IO ((Plane (Word32, YUV Float)) -> IO ColorImage8)
+finalizeCountCanvas :: IO (Planes (Word32, YUV Float) -> IO ColorImage8)
 finalizeCountCanvas =
    RenderP.run $
       colorImageByteFromFloat .
       Symb.map
-         (Expr.modify (atom,atom) $ \(count, pixel) ->
+         (Expr.modify (Tuple (atom,atom)) $ \(Tuple (count, pixel)) ->
             Arith.vecScale vecYUV (recip $ fromInt count) pixel) .
       Symb.fix
 
@@ -1087,34 +1085,34 @@
 diffAbs = Expr.liftM2 $ \x y -> MultiValue.abs =<< MultiValue.sub x y
 
 diffWithCanvas ::
-   IO (RotatedImage -> Plane (YUV Float) -> IO (Plane (Bool8, Float)))
+   IO (RotatedImage -> Plane (YUV Float) -> IO (Planes (Bool8, Float)))
 diffWithCanvas =
    RenderP.run $ \(rot, mov, pic) avg ->
       Symb.zipWith
          (Expr.modify2 (atom,atom) atom $ \(b,x) y ->
-            (b, diffAbs (brightnessValue x) (brightnessValue y)))
+            Tuple (b, diffAbs (Color.brightness x) (Color.brightness y)))
          (rotateStretchMove vecYUV rot mov (Symb.shape avg) $
           colorImageFloatFromByte pic)
          avg
 
 finalizeCountCanvasFloat ::
-   IO ((Plane (Word32, YUV Float)) -> IO (Plane (YUV Float)))
+   IO ((Planes (Word32, YUV Float)) -> IO (Plane (YUV Float)))
 finalizeCountCanvasFloat =
    RenderP.run $
       Symb.map
-         (Expr.modify (atom,atom) $ \(count, pixel) ->
+         (Expr.modify (Tuple (atom,atom)) $ \(Tuple (count, pixel)) ->
             Arith.vecScale vecYUV (recip $ fromInt count) pixel)
       .
       Symb.fix
 
 emptyCanvas :: IO (Dim2 -> IO ColorImage8)
-emptyCanvas = RenderP.run $ \sh -> Symb.fill sh (Expr.zip3 0 0 0)
+emptyCanvas = RenderP.run $ \sh -> Symb.fill sh (Color.yuv 0 0 0)
 
 addMaskedToCanvas ::
    IO (RotatedImage ->
        Plane Bool8 ->
-       Plane (YUV Word8) ->
-       IO (Plane (YUV Word8)))
+       ColorImage8 ->
+       IO ColorImage8)
 addMaskedToCanvas =
    RenderP.run $ \(rot, mov, pic) mask canvas ->
       Symb.zipWith3 Expr.ifThenElse
@@ -1127,10 +1125,11 @@
 updateShapedCanvas ::
    IO (RotatedImage ->
        Plane Float ->
-       Plane (Float, YUV Float) ->
-       IO (Plane (Float, YUV Float)))
+       Planes (Float, YUV Float) ->
+       IO (Planes (Float, YUV Float)))
 updateShapedCanvas =
    RenderP.run $ \(rot, mov, pic) shape weightCanvas ->
+      Symb.map Expr.tuple $
       addToWeightedCanvas vecYUV
          (Symb.zipWith
             (Expr.modify2 atom (atom,atom) $ \s (b,x) ->
@@ -1138,7 +1137,7 @@
             shape $
           rotateStretchMove vecYUV rot mov (Symb.shape weightCanvas) $
           colorImageFloatFromByte pic)
-         weightCanvas
+         (Symb.map Expr.untuple weightCanvas)
 
 
 maybePlus ::
@@ -1229,8 +1228,7 @@
       array (Symb.lift0 $ Symb.id $
              Expr.compose $ Shape.ZeroBased (4 :: Exp SmallSize))
 
-distanceMapBoxRun ::
-   IO (Dim2 -> Geometry Float -> IO (Plane Word8))
+distanceMapBoxRun :: IO (Dim2 -> Geometry Float -> IO (Plane Word8))
 distanceMapBoxRun =
    RenderP.run $ \sh geom ->
       scaleDistanceMapGeom geom $
@@ -1284,8 +1282,10 @@
 distanceMapContainedRun = do
    distances <-
       RenderP.run $
-      \sh this -> scaleDistanceMapGeom this . distanceMapContained sh this
-   return $ \sh this others -> distances sh this =<< Phys.vectorFromList others
+      \sh this ->
+         scaleDistanceMapGeom this .
+         distanceMapContained sh this . geometryArray
+   return $ \sh this others -> distances sh this =<< geometryVector others
 
 scaleDistanceMapGeom ::
    (MultiValue.Field a, MultiValue.Real a, MultiValue.RationalConstant a,
@@ -1296,6 +1296,32 @@
    in  imageByteFromFloat $ Symb.map (scale*) img
 
 
+pointsVector ::
+   [Arith.Point2 Float] ->
+   IO (ComfortArray.Array SmallDim (Tuple (Arith.Point2 Float)))
+pointsVector = Phys.vectorFromList . map Tuple
+
+pointsArray ::
+   Symb.Array SmallDim (Tuple (Arith.Point2 a)) ->
+   Symb.Array SmallDim (Arith.Point2 a)
+pointsArray = Symb.map Expr.untuple
+
+type TupledGeometry a = Tuple (Tuple (a,a), Tuple (a,a), Tuple (Size,Size))
+
+geometryVector ::
+   (SV.Storable a) =>
+   [Geometry a] -> IO (ComfortArray.Array SmallDim (TupledGeometry a))
+geometryVector =
+   Phys.vectorFromList . map (Tuple . mapTriple (Tuple, Tuple, Tuple))
+
+geometryArray ::
+   Symb.Array SmallDim (TupledGeometry a) ->
+   Symb.Array SmallDim (Geometry a)
+geometryArray =
+   Symb.map
+      (Expr.mapTriple (Expr.untuple, Expr.untuple, Expr.untuple) . Expr.untuple)
+
+
 pixelCoordinates ::
    (MultiValue.NativeFloating a ar) => Exp Dim2 -> SymbPlane (a,a)
 pixelCoordinates sh =
@@ -1316,8 +1342,10 @@
 distanceMapPointsRun = do
    distances <-
       RenderP.run $
-      \sh -> scaleDistanceMap . distanceMapPoints (pixelCoordinates sh)
-   return $ \sh points -> distances sh =<< Phys.vectorFromList points
+      \sh ->
+         scaleDistanceMap .
+         distanceMapPoints (pixelCoordinates sh) . pointsArray
+   return $ \sh points -> distances sh =<< pointsVector points
 
 
 scaleDistanceMap ::
@@ -1369,20 +1397,19 @@
 distanceMapRun = do
    distances <-
       RenderP.run $
-      \sh this others -> scaleDistanceMap . distanceMap sh this others
-   return $ \sh this others points -> do
-      othersVec <- Phys.vectorFromList others
-      pointsVec <- Phys.vectorFromList points
-      distances sh this othersVec pointsVec
+      \sh this ->
+         scaleDistanceMap .
+         uncurry (distanceMap sh this) . mapPair (geometryArray, pointsArray)
+   return $ \sh this others points ->
+      distances sh this =<<
+         liftA2 (,) (geometryVector others) (pointsVector points)
 
 
 pow ::
-   (MultiValue.Repr LLVM.Value a ~ LLVM.Value ar,
+   (Tuple.ValueOf a ~ LLVM.Value ar,
     LLVM.IsFloating ar, SoV.TranscendentalConstant ar) =>
    Exp a -> Exp a -> Exp a
-pow =
-   flip $ Expr.liftM2 $ \(MultiValue.Cons x) (MultiValue.Cons y) ->
-      fmap MultiValue.Cons $ LLVMArith.pow x y
+pow = flip $ Expr.liftTupleM2 LLVMArith.pow
 
 distanceMapGamma ::
    (MultiValue.Algebraic a, MultiValue.Real a,
@@ -1393,15 +1420,16 @@
    Exp Dim2 ->
    Exp (Geometry a) ->
    Symb.Array SmallDim (Geometry a) ->
-   Symb.Array SmallDim (a, a) ->
+   Symb.Array SmallDim (Arith.Point2 a) ->
    SymbPlane a
 distanceMapGamma gamma sh this others points =
    Symb.map (pow gamma) $ distanceMap sh this others points
 
 
-emptyWeightedCanvas :: IO (Dim2 -> IO (Plane (Float, YUV Float)))
+emptyWeightedCanvas :: IO (Dim2 -> IO (Planes (Float, YUV Float)))
 emptyWeightedCanvas =
-   RenderP.run $ \sh -> Symb.fill sh (Expr.zip 0 $ Expr.zip3 0 0 0)
+   RenderP.run $ \sh ->
+      Symb.fill sh $ Expr.tuple $ Expr.zip 0 $ Color.yuv 0 0 0
 
 addToWeightedCanvas ::
    (MultiValue.PseudoRing a, MultiValue.NativeFloating a ar) =>
@@ -1422,38 +1450,42 @@
        [Geometry Float] ->
        [Arith.Point2 Float] ->
        ColorImage8 ->
-       Plane (Float, YUV Float) ->
-       IO (Plane (Float, YUV Float)))
+       Planes (Float, YUV Float) ->
+       IO (Planes (Float, YUV Float)))
 updateWeightedCanvas = do
-   distances <- RenderP.run distanceMapGamma
+   distances <-
+      RenderP.run $
+         \gamma shape this ->
+            uncurry (distanceMapGamma gamma shape this) .
+            mapPair (geometryArray, pointsArray)
 
    update <-
       RenderP.run $ \this pic dist weightSumCanvas ->
             let (rot, mov, _) = Expr.unzip3 this
-            in  addToWeightedCanvas vecYUV
+            in Symb.map Expr.tuple $
+               addToWeightedCanvas vecYUV
                   (Symb.zip dist $
                    Symb.map Expr.snd $
                    rotateStretchMove vecYUV rot mov
                       (Symb.shape weightSumCanvas) $
                    colorImageFloatFromByte pic)
-                  weightSumCanvas
+                  (Symb.map Expr.untuple weightSumCanvas)
 
    return $ \gamma this others points pic weightSumCanvas -> do
-      othersVec <- Phys.vectorFromList others
-      pointsVec <- Phys.vectorFromList points
       dists <-
-         distances
-            gamma (Phys.shape weightSumCanvas) this
-            othersVec pointsVec
+         distances gamma (Phys.shape weightSumCanvas) this
+         =<<
+         liftA2 (,) (geometryVector others) (pointsVector points)
+
       update this pic dists weightSumCanvas
 
 
-finalizeWeightedCanvas :: IO (Plane (Float, YUV Float) -> IO ColorImage8)
+finalizeWeightedCanvas :: IO (Planes (Float, YUV Float) -> IO ColorImage8)
 finalizeWeightedCanvas =
    RenderP.run $
       colorImageByteFromFloat .
       Symb.map
-         (Expr.modify (atom,atom) $ \(weightSum, pixel) ->
+         (Expr.modify (Tuple (atom,atom)) $ \(Tuple (weightSum, pixel)) ->
             Arith.vecScale vecYUV (recip weightSum) pixel) .
       Symb.fix
 
@@ -1552,10 +1584,10 @@
    let (poss, dps) =
           absolutePositionsFromPairDisplacements
              (fixAtLeastOnePosition (0,0) $ map picParam pics) overlaps
-   info "\nabsolute positions"
+   info "\nabsolute positions\n"
    info $ unlines $ map show poss
 
-   info "\ncompare position differences with pair displacements"
+   info "\ncompare position differences with pair displacements\n"
    info $ unlines $
       zipWith
          (\(dpx,dpy) (dx,dy) ->
@@ -1628,11 +1660,11 @@
                         (\(score,pa,pb) ->
                            (score, (add pa leftTopA, add pb leftTopB))) <$>
                      optimalOverlapShared mMaxDiff picA picB
-                  info $ printf "left-top: %s, %s" (show leftTopA) (show leftTopB)
-                  info $ printf "%s - %s" pathA pathB
+                  info $ printf "left-top: %s, %s\n" (show leftTopA) (show leftTopB)
+                  info $ printf "%s - %s\n" pathA pathB
                   forM_ corrs $ \(score, (pa@(xa,ya),pb@(xb,yb))) ->
                      info $
-                        printf "%s ~ %s, (%f,%f), %f"
+                        printf "%s ~ %s, (%f,%f), %f\n"
                            (show pa) (show pb) (xb-xa) (yb-ya) score
                   return $ map snd corrs
          return ((ia,ib), (pathA,pathB), correspondences)
@@ -1647,7 +1679,7 @@
               fixAtLeastOneAnglePosition (Degree 0, (0,0)) $
               map picParam pics)
              overlaps
-   info "\nabsolute positions and rotations: place, rotation (magnitude, phase)"
+   info "\nabsolute positions and rotations: place, rotation (magnitude, phase)\n"
    infoPlain $ unlines $
       map
          (\((dx,dy),r) ->
@@ -1657,7 +1689,7 @@
                (getDegree $ Degree.fromRadian $ Complex.phase r))
          posRots
 
-   info "\ncompare position differences with pair displacements"
+   info "\ncompare position differences with pair displacements\n"
    infoPlain $ unlines $
       zipWith
          (\(dpx,dpy) (_i, ((xa,ya),(xb,yb))) ->
@@ -1678,7 +1710,7 @@
 
    inputs <- Option.images args
 
-   notice "\nfind rotation angles"
+   notice "\nfind rotation angles\n"
    findOptRot <- findOptimalRotation
    picAngles <-
       forM inputs $ \(State.Proposed path (maybeAngle, _) _) -> do
@@ -1696,7 +1728,7 @@
       State.write (printf format "angle") $
          zipWith State.Angle (map State.propPath inputs) (map fst picAngles)
 
-   notice "\nfind relative placements"
+   notice "\nfind relative placements\n"
    prepOverlapMatching <- prepareOverlapMatching
    rotated <- mapM (prepOverlapMatching (Option.smooth opt)) picAngles
 
@@ -1748,7 +1780,7 @@
                (angle <> Degree.fromRadian (Complex.phase rot)) pos)
          paths picAngles posRots
 
-   notice "\ncompose all parts"
+   notice "\ncompose all parts\n"
    let ((canvasWidth, canvasHeight), rotMovPics, canvasMsgs) =
          Arith.canvasShape colorImageExtent
             (map (mapFst Degree.toRadian) picAngles) posRots
@@ -1765,7 +1797,7 @@
          foldM (flip updateCanv) empty rotMovPics
 
 
-   notice "\ndistance maps"
+   notice "\ndistance maps\n"
    let geometryRelations =
          Arith.geometryRelations $
          map (Arith.geometryFeatures . mapThd3 colorImageExtent) rotMovPics
@@ -1800,7 +1832,7 @@
             uncurry3 (distMap canvasShape) geoms
 
    forM_ (Option.output opt) $ \path -> do
-      notice "\nweighted composition"
+      notice "\nweighted composition\n"
       emptyCanv <- emptyWeightedCanvas
       updateCanv <- updateWeightedCanvas
       finalizeCanv <- finalizeWeightedCanvas
@@ -1814,7 +1846,7 @@
             empty (zip geometryRelations picAngles)
 
    when (isJust (Option.outputShaped opt) || isJust (Option.outputShapedHard opt)) $ do
-      notice "\nmatch shapes"
+      notice "\nmatch shapes\n"
       emptyCanv <- emptyCountCanvas
       updateCanv <- updateCountCanvas
       finalizeCanv <- finalizeCountCanvasFloat
@@ -1825,16 +1857,17 @@
       avg <- finalizeCanv sumImg
       diff <- diffWithCanvas
       picDiffs <- mapM (flip diff avg) rotMovPics
-      getSnd <- RenderP.run $ Symb.map Expr.snd . Symb.fix
+      getSnd <- RenderP.run $ Symb.map (Expr.snd . Expr.untuple) . Symb.fix
       lp <- lowpassMulti
-      let masks = map (ComfortArray.map fst . arrayPairFromVec) picDiffs
+      let masks =
+            map (ComfortArray.map (fst.getTuple) . arrayPairFromVec) picDiffs
       let smoothRadius = Option.shapeSmooth opt
       smoothPicDiffs <-
          mapM (fmap arrayPairFromVec . lp smoothRadius <=< getSnd) picDiffs
       (locs, pqueue) <-
          MatchImageBorders.prepareShaping $ zip masks smoothPicDiffs
       counts <-
-         MutArray.thaw . ComfortArray.map (fromIntegral . fst) $
+         MutArray.thaw . ComfortArray.map (fromIntegral . fst . getTuple) $
          arrayPairFromVec sumImg
       shapes <- MatchImageBorders.shapeParts counts locs pqueue
 
diff --git a/src/Knead/CArray.hs b/src/Knead/CArray.hs
--- a/src/Knead/CArray.hs
+++ b/src/Knead/CArray.hs
@@ -7,8 +7,8 @@
 import qualified Math.FFT as FFT
 import Math.FFT.Base (FFTWReal)
 
+import Foreign.Storable.Record.Tuple (Tuple(Tuple))
 import Foreign.Storable (Storable)
-import Foreign.Storable.Tuple ()
 
 import qualified Data.Array.Comfort.Shape as ComfortShape
 import Data.Array.Comfort.Storable.Unchecked (Array(Array))
@@ -96,9 +96,12 @@
 -- ToDo: could be moved to fft package
 untangleSpectra2d ::
    (Fractional a, Storable a) =>
-   CArray (Int,Int) (Complex a) -> CArray (Int,Int) (Complex a, Complex a)
+   CArray (Int,Int) (Complex a) ->
+   CArray (Int,Int) (Tuple (Complex a, Complex a))
 untangleSpectra2d spec =
-   CArray.liftArray2 untangleCoefficient spec (cyclicReverse2d spec)
+   CArray.liftArray2
+      ((Tuple.) . untangleCoefficient)
+      spec (cyclicReverse2d spec)
 
 {- |
 Equivalent to @amap (uncurry Komplex.mulConj) . untangleSpectra2d@
diff --git a/src/Knead/Color.hs b/src/Knead/Color.hs
new file mode 100644
--- /dev/null
+++ b/src/Knead/Color.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Knead.Color where
+
+import qualified Data.Array.Knead.Expression as Expr
+import Data.Array.Knead.Expression (Exp)
+
+import qualified LLVM.Extra.Storable as Storable
+import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.Vector as Vector
+import qualified LLVM.Extra.Tuple as Tuple
+
+import qualified LLVM.Core as LLVM
+
+import qualified Type.Data.Num.Decimal as TypeNum
+
+import qualified Foreign.Storable.Traversable as StoreTrav
+import Foreign.Storable (Storable, sizeOf, alignment, poke, peek)
+import Foreign.Ptr (Ptr)
+
+import Control.Monad ((<=<))
+import Control.Applicative (Applicative, liftA3, pure, (<*>))
+
+import Data.Traversable (Traversable, traverse)
+import Data.Foldable (Foldable, foldMap)
+import Data.Monoid ((<>))
+
+
+
+data YUV a = YUV a a a
+
+instance Functor YUV where
+   fmap f (YUV y u v) = YUV (f y) (f u) (f v)
+
+instance Foldable YUV where
+   foldMap f (YUV y u v) = f y <> f u <> f v
+
+instance Traversable YUV where
+   traverse f (YUV y u v) = liftA3 YUV (f y) (f u) (f v)
+
+instance Applicative YUV where
+   pure a = YUV a a a
+   YUV fy fu fv <*> YUV y u v = YUV (fy y) (fu u) (fv v)
+
+
+instance (Storable a) => Storable (YUV a) where
+   sizeOf = StoreTrav.sizeOf . lazyElements
+   alignment = StoreTrav.alignment
+   peek = StoreTrav.peekApplicative
+   poke = StoreTrav.poke
+
+lazyElements :: YUV a -> YUV a
+lazyElements ~(YUV y u v) = YUV y u v
+
+instance
+   (Storable.Vector a, LLVM.IsPrimitive a, LLVM.IsConst a,
+    Tuple.VectorValue TypeNum.D3 a,
+    Tuple.VectorValueOf TypeNum.D3 a ~ LLVM.Value (LLVM.Vector TypeNum.D3 a)) =>
+      Storable.C (YUV a) where
+   load = Storable.load <=< castVectorPtr
+   store x = Storable.store x <=< castVectorPtr
+
+castVectorPtr ::
+   LLVM.Value (Ptr (YUV a)) ->
+   LLVM.CodeGenFunction r (LLVM.Value (Ptr (LLVM.Vector TypeNum.D3 a)))
+castVectorPtr = LLVM.bitcast
+
+
+instance
+   (LLVM.IsPrimitive a, LLVM.IsConst a) =>
+      Tuple.Value (YUV a) where
+   type ValueOf (YUV a) = LLVM.Value (LLVM.Vector TypeNum.D3 a)
+   valueOf (YUV a0 a1 a2) = LLVM.valueOf $ LLVM.consVector a0 a1 a2
+
+instance
+   (LLVM.IsPrimitive a, LLVM.IsConst a) =>
+      MultiValue.C (YUV a) where
+   cons = MultiValue.consTuple
+   undef = MultiValue.undefTuple
+   zero = MultiValue.zeroTuple
+   phi = MultiValue.phiTuple
+   addPhi = MultiValue.addPhiTuple
+
+
+yuv ::
+   (LLVM.IsPrimitive a, Tuple.ValueOf a ~ LLVM.Value a) =>
+   Exp a -> Exp a -> Exp a -> Exp (YUV a)
+yuv =
+   Expr.liftTupleM3
+      (\y u v -> do
+         arr0 <- LLVM.insertelement Tuple.undef y (LLVM.valueOf 0)
+         arr1 <- LLVM.insertelement arr0 u (LLVM.valueOf 1)
+         LLVM.insertelement arr1 v (LLVM.valueOf 2))
+
+brightness ::
+   (LLVM.IsPrimitive a, Tuple.ValueOf a ~ LLVM.Value a) =>
+   Exp (YUV a) -> Exp a
+brightness =
+   Expr.liftTupleM (flip LLVM.extractelement (LLVM.valueOf 0))
+
+mapPlain ::
+   (LLVM.IsPrimitive a, LLVM.IsPrimitive b) =>
+   (forall r. LLVM.Value a -> LLVM.CodeGenFunction r (LLVM.Value b)) ->
+   Exp (YUV a) -> Exp (YUV b)
+mapPlain f = Expr.liftTupleM (Vector.map f)
+
+exprUnliftM1 ::
+   (Tuple.ValueOf a ~ al, Tuple.ValueOf b ~ bl) =>
+   (Exp a -> Exp b) -> al -> LLVM.CodeGenFunction r bl
+exprUnliftM1 f a =
+   fmap (\(MultiValue.Cons b) -> b) $ Expr.unliftM1 f $ MultiValue.Cons a
+
+map ::
+   (LLVM.IsPrimitive a, Tuple.ValueOf a ~ LLVM.Value a,
+    LLVM.IsPrimitive b, Tuple.ValueOf b ~ LLVM.Value b) =>
+   (Exp a -> Exp b) -> Exp (YUV a) -> Exp (YUV b)
+map f = mapPlain (exprUnliftM1 f)
diff --git a/src/Knead/Shape.hs b/src/Knead/Shape.hs
--- a/src/Knead/Shape.hs
+++ b/src/Knead/Shape.hs
@@ -7,8 +7,10 @@
 
 import qualified Data.Array.Comfort.Shape as ComfortShape
 
-import qualified LLVM.Extra.Multi.Value.Memory as MultiMem
+import qualified LLVM.Extra.Marshal as Marshal
+import qualified LLVM.Extra.Memory as Memory
 import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.Tuple as Tuple
 import qualified LLVM.Extra.Iterator as Iter
 import qualified LLVM.Extra.Arithmetic as A
 import LLVM.Extra.Multi.Value (atom)
@@ -81,23 +83,36 @@
       let q = castToElemPtr p
       in  Monad.lift2 Vec2 (peek q) (peekElemOff q 1)
 
+instance (Tuple.Undefined n) => Tuple.Undefined (Vec2 tag n) where
+   undef = Vec2 Tuple.undef Tuple.undef
+
+instance (Tuple.Phi n) => Tuple.Phi (Vec2 tag n) where
+   phi bb (Vec2 a0 a1) =
+      Monad.lift2 Vec2 (Tuple.phi bb a0) (Tuple.phi bb a1)
+   addPhi bb (Vec2 a0 a1) (Vec2 b0 b1) =
+      Tuple.addPhi bb a0 b0 >>
+      Tuple.addPhi bb a1 b1
+
+instance (Tuple.Value n) => Tuple.Value (Vec2 tag n) where
+   type ValueOf (Vec2 tag n) = Vec2 tag (Tuple.ValueOf n)
+   valueOf (Vec2 n m) = Vec2 (Tuple.valueOf n) (Tuple.valueOf m)
+
 instance (MultiValue.C n) => MultiValue.C (Vec2 tag n) where
-   type Repr f (Vec2 tag n) = Vec2 tag (MultiValue.Repr f n)
    cons (Vec2 n m) =
       MultiValue.compose $ Vec2 (MultiValue.cons n) (MultiValue.cons m)
    undef = MultiValue.compose $ squareShape MultiValue.undef
    zero = MultiValue.compose $ squareShape MultiValue.zero
-   phis bb a =
+   phi bb a =
       case MultiValue.decompose (squareShape atom) a of
          Vec2 a0 a1 ->
             fmap MultiValue.compose $
-            Monad.lift2 Vec2 (MultiValue.phis bb a0) (MultiValue.phis bb a1)
-   addPhis bb a b =
+            Monad.lift2 Vec2 (MultiValue.phi bb a0) (MultiValue.phi bb a1)
+   addPhi bb a b =
       case (MultiValue.decompose (squareShape atom) a,
             MultiValue.decompose (squareShape atom) b) of
          (Vec2 a0 a1, Vec2 b0 b1) ->
-            MultiValue.addPhis bb a0 b0 >>
-            MultiValue.addPhis bb a1 b1
+            MultiValue.addPhi bb a0 b0 >>
+            MultiValue.addPhi bb a1 b1
 
 type instance
    MultiValue.Decomposed f (Vec2 tag pat) =
@@ -119,20 +134,25 @@
          (MultiValue.decompose pn (MultiValue.Cons n))
          (MultiValue.decompose pm (MultiValue.Cons m))
 
-instance (MultiMem.C i) => MultiMem.C (Vec2 tag i) where
+instance (Memory.C i) => Memory.C (Vec2 tag i) where
    type Struct (Vec2 tag i) =
-         LLVM.Struct (MultiMem.Struct i, (MultiMem.Struct i, ()))
+            LLVM.Struct (Memory.Struct i, (Memory.Struct i, ()))
    decompose nm =
-      Monad.lift2 zipShape
-         (MultiMem.decompose =<< LLVM.extractvalue nm TypeNum.d0)
-         (MultiMem.decompose =<< LLVM.extractvalue nm TypeNum.d1)
-   compose nm =
-      case unzipShape nm of
-         Vec2 n m -> do
-            sn <- MultiMem.compose n
-            sm <- MultiMem.compose m
-            rn <- LLVM.insertvalue (LLVM.value LLVM.undef) sn TypeNum.d0
-            LLVM.insertvalue rn sm TypeNum.d1
+      Monad.lift2 Vec2
+         (Memory.decompose =<< LLVM.extractvalue nm TypeNum.d0)
+         (Memory.decompose =<< LLVM.extractvalue nm TypeNum.d1)
+   compose (Vec2 n m) = do
+      sn <- Memory.compose n
+      sm <- Memory.compose m
+      rn <- LLVM.insertvalue (LLVM.value LLVM.undef) sn TypeNum.d0
+      LLVM.insertvalue rn sm TypeNum.d1
+
+instance (Marshal.C i) => Marshal.C (Vec2 tag i) where
+   pack (Vec2 n m) = LLVM.consStruct (Marshal.pack n) (Marshal.pack m)
+   unpack =
+      LLVM.uncurryStruct $ \n m -> Vec2 (Marshal.unpack n) (Marshal.unpack m)
+
+instance (Marshal.C i, MultiValue.C i) => Marshal.MV (Vec2 tag i) where
 
 
 unzipShape :: MultiValue.T (Vec2 tag n) -> Vec2 tag (MultiValue.T n)
diff --git a/src/Option.hs b/src/Option.hs
--- a/src/Option.hs
+++ b/src/Option.hs
@@ -1,9 +1,14 @@
 module Option where
 
 import qualified State
-import Option.Utility (exitFailureMsg, parseNumber, fmapOptDescr)
 import Degree (Degree(Degree, getDegree))
 
+import qualified Shell.Utility.Verbosity as Verbosity
+import Shell.Utility.Verbosity (Verbosity)
+import Shell.Utility.ParseArgument (parseNumber)
+import Shell.Utility.Exit (exitFailureMsg)
+import Shell.Utility.GetOpt (fmapOptDescr)
+
 import qualified System.Console.GetOpt as Opt
 import qualified System.Environment as Env
 import System.Console.GetOpt (ArgDescr(NoArg, ReqArg), getOpt, usageInfo)
@@ -13,7 +18,7 @@
 
 import Control.Monad (when)
 
-import qualified Data.EnumSet as EnumSet
+import qualified Data.EnumBitSet as EnumSet
 import qualified Data.Vector as Vector
 import qualified Data.Map as Map
 import qualified Data.List.HT as ListHT
@@ -22,10 +27,6 @@
 import Data.Monoid ((<>))
 import Data.Word (Word8)
 
-import qualified Distribution.Verbosity as Verbosity
-import qualified Distribution.ReadE as ReadE
-import Distribution.Verbosity (Verbosity)
-
 import Text.Printf (printf)
 
 
@@ -153,10 +154,8 @@
       "show options" :
 
    opt generic ['v'] ["verbose"]
-      (flip ReqArg "N" $ \str flags -> do
-         case ReadE.runReadE Verbosity.flagToVerbosity str of
-            Right n -> return (flags{verbosity = n})
-            Left msg -> exitFailureMsg msg)
+      (flip ReqArg "N" $ \str flags ->
+         fmap (\verb -> flags{verbosity = verb}) $ Verbosity.parse str)
       (printf "verbosity level: 0..3, default: %d"
          (fromEnum $ verbosity defltOption)) :
 
diff --git a/src/Option/Utility.hs b/src/Option/Utility.hs
deleted file mode 100644
--- a/src/Option/Utility.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-module Option.Utility where
-
-import qualified System.Console.GetOpt as G
-import qualified System.Exit as Exit
-import qualified System.IO as IO
-
-
-parseNumber ::
-   (Read a) =>
-   String -> (a -> Bool) -> String -> String -> IO a
-parseNumber name constraint constraintName str =
-   case reads str of
-      [(n, "")] ->
-         if constraint n
-           then return n
-           else exitFailureMsg $ name ++ " must be a " ++ constraintName ++ " number"
-      _ ->
-         exitFailureMsg $ name ++ " must be a number, but is '" ++ str ++ "'"
-
-exitFailureMsg :: String -> IO a
-exitFailureMsg msg = do
-    IO.hPutStrLn IO.stderr msg
-    Exit.exitFailure
-
-fmapArgDescr :: (a -> b) -> (G.ArgDescr a -> G.ArgDescr b)
-fmapArgDescr f d =
-    case d of
-        G.NoArg a -> G.NoArg $ f a
-        G.ReqArg g str -> G.ReqArg (f.g) str
-        G.OptArg g str -> G.OptArg (f.g) str
-
-fmapOptDescr :: (a -> b) -> (G.OptDescr a -> G.OptDescr b)
-fmapOptDescr f (G.Option short long arg help) =
-    G.Option short long (fmapArgDescr f arg) help