diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs
--- a/Data/IP/Addr.hs
+++ b/Data/IP/Addr.hs
@@ -52,8 +52,12 @@
 
 >>> read "2001:db8:00:00:00:00:00:01" :: IPv6
 2001:db8:00:00:00:00:00:01
->>> read "2001:240:11e:c00::101" :: IPv6
-2001:240:11e:c00:00:00:00:101
+>>> read "2001:db8:11e:c00::101" :: IPv6
+2001:db8:11e:c00:00:00:00:101
+>>> read "2001:db8:11e:c00:aa:bb:192.0.2.1" :: IPv6
+2001:db8:11e:c00:aa:bb:c000:201
+>>> read "2001:db8::192.0.2.1" :: IPv6
+2001:db8:00:00:00:00:c000:201
 -}
 newtype IPv6 = IP6 IPv6Addr deriving (Eq, Ord)
 
@@ -70,21 +74,23 @@
 
 showIPv4 :: IPv4 -> String
 showIPv4 (IP4 a) = show4 a
-    where
-      remQuo x = (x `mod` 256, x `div` 256)
-      show4 q = let (a4,q4) = remQuo q
-                    (a3,q3) = remQuo q4
-                    (a2,q2) = remQuo q3
-                    (a1, _) = remQuo q2
-                 in printf "%d.%d.%d.%d" a1 a2 a3 a4
+  where
+    remQuo x = (x `mod` 256, x `div` 256)
+    show4 q = printf "%d.%d.%d.%d" a1 a2 a3 a4
+      where
+        (a4,q4) = remQuo q
+        (a3,q3) = remQuo q4
+        (a2,q2) = remQuo q3
+        (a1, _) = remQuo q2
 
 showIPv6 :: IPv6 -> String
 showIPv6 (IP6 (a1,a2,a3,a4)) = show6 a1 ++ ":" ++ show6 a2 ++ ":" ++ show6 a3 ++ ":" ++ show6 a4
-    where
-      remQuo x = (x `mod` 65536, x `div` 65536)
-      show6 q = let (r2,q2) = remQuo q
-                    (r1, _) = remQuo q2
-                in printf "%02x:%02x" r1 r2
+  where
+    remQuo x = (x `mod` 65536, x `div` 65536)
+    show6 q = printf "%02x:%02x" r1 r2
+      where
+        (r2,q2) = remQuo q
+        (r1, _) = remQuo q2
 
 ----------------------------------------------------------------
 --
@@ -99,9 +105,9 @@
 -}
 toIPv4 :: [Int] -> IPv4
 toIPv4 = IP4 . toWord32
-    where
-      toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4
-      toWord32 _             = error "toWord32"
+  where
+    toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4
+    toWord32 _             = error "toWord32"
 
 {-|
   The 'toIPv6' function takes a list of 'Int' and returns 'IPv6'.
@@ -110,13 +116,13 @@
 2001:db8:00:00:00:00:00:01
 -}
 toIPv6 :: [Int] -> IPv6
-toIPv6 ad = let [x1,x2,x3,x4] = map toWord32 $ split2 ad
-            in IP6 (x1,x2,x3,x4)
-    where
-      split2 [] = []
-      split2 x  = take 2 x : split2 (drop 2 x)
-      toWord32 [a1,a2] = fromIntegral $ shift a1 16 + a2
-      toWord32 _             = error "toWord32"
+toIPv6 ad = IP6 (x1,x2,x3,x4)
+  where
+    [x1,x2,x3,x4] = map toWord32 $ split2 ad
+    split2 [] = []
+    split2 x  = take 2 x : split2 (drop 2 x)
+    toWord32 [a1,a2] = fromIntegral $ shift a1 16 + a2
+    toWord32 _       = error "toWord32"
 
 ----------------------------------------------------------------
 --
@@ -159,12 +165,11 @@
     readsPrec _ = parseIPv6
 
 parseIP :: String -> [(IP,String)]
-parseIP cs =
-  case runParser ip4 cs of
-       (Just ip,rest) -> [(IPv4 ip,rest)]
-       (Nothing,_) -> case runParser ip6 cs of
-                           (Just ip,rest) -> [(IPv6 ip,rest)]
-                           (Nothing,_) -> error $ "parseIP" ++ cs
+parseIP cs = case runParser ip4 cs of
+    (Just ip,rest) -> [(IPv4 ip,rest)]
+    (Nothing,_) -> case runParser ip6 cs of
+        (Just ip,rest) -> [(IPv6 ip,rest)]
+        (Nothing,_) -> error $ "parseIP" ++ cs
 
 parseIPv4 :: String -> [(IPv4,String)]
 parseIPv4 cs = case runParser ip4 cs of
@@ -202,15 +207,19 @@
     toInt n ns = foldl' (\x y -> x * 10 + y) 0 . map digitToInt $ n : ns
 
 ip4 :: Parser IPv4
-ip4 = do
+ip4 = toIPv4 <$> ip4'
+
+ip4' :: Parser [Int]
+ip4' = do
     as <- dig `sepBy1` char '.'
     check as
-    return $ toIPv4 as
+    return as
   where
     test errmsg adr = when (adr < 0 || 255 < adr) (fail errmsg)
-    check as = do let errmsg = "IPv4 adddress"
-                  when (length as /= 4) (fail errmsg)
-                  mapM_ (test errmsg) as
+    check as = do
+        let errmsg = "IPv4 adddress"
+        when (length as /= 4) (fail errmsg)
+        mapM_ (test errmsg) as
 
 ----------------------------------------------------------------
 --
@@ -218,41 +227,71 @@
 --
 
 hex :: Parser Int
-hex = do ns <- some hexDigit
-         check ns
-         let ms = map digitToInt ns
-             val = foldl' (\x y -> x * 16 + y) 0 ms
-         return val
-    where
-      check ns = when (length ns > 4) (fail "IPv6 address -- more than 4 hex")
+hex = do
+    ns <- some hexDigit
+    check ns
+    let ms = map digitToInt ns
+        val = foldl' (\x y -> x * 16 + y) 0 ms
+    return val
+  where
+    check ns = when (length ns > 4) (fail "IPv6 address -- more than 4 hex")
 
+colon2 :: Parser String
+colon2 = string "::"
+
+format :: [Int] -> [Int] -> Parser [Int]
+format bs1 bs2 = do
+    let len1 = length bs1
+        len2 = length bs2
+    when (len1 > 7) (fail "IPv6 address1")
+    when (len2 > 7) (fail "IPv6 address2")
+    let len = 8 - len1 - len2
+    when (len <= 0) (fail "IPv6 address3")
+    let spring = replicate len 0
+    return $ bs1 ++ spring ++ bs2
+
 ip6 :: Parser IPv6
 ip6 = toIPv6 <$> ip6'
 
 ip6' :: Parser [Int]
-ip6' =      do colon2
-               bs <- option [] hexcolon
-               format [] bs
-        <|> try (do rs <- hexcolon
-                    check rs
-                    return rs)
-        <|> do bs1 <- hexcolon2
-               bs2 <- option [] hexcolon
-               format bs1 bs2
-    where
-      colon2 = string "::"
-      hexcolon = hex `sepBy1` char ':'
-      hexcolon2 = manyTill (hex <* char ':') (char ':')
-      format bs1 bs2 = do let len1 = length bs1
-                              len2 = length bs2
-                          when (len1 > 7) (fail "IPv6 address1")
-                          when (len2 > 7) (fail "IPv6 address2")
-                          let len = 8 - len1 - len2
-                          when (len <= 0) (fail "IPv6 address3")
-                          let spring = replicate len 0
-                          return $ bs1 ++ spring ++ bs2
-      check bs = when (length bs /= 8) (fail "IPv6 address4")
+ip6' = ip4Embedded
+   <|> do colon2
+          bs <- option [] hexcolon
+          format [] bs
+   <|> try (do rs <- hexcolon
+               check rs
+               return rs)
+   <|> do bs1 <- hexcolon2
+          bs2 <- option [] hexcolon
+          format bs1 bs2
+  where
+    hexcolon = hex `sepBy1` char ':'
+    hexcolon2 = manyTill (hex <* char ':') (char ':')
+    check bs = when (length bs /= 8) (fail "IPv6 address4")
 
+ip4Embedded :: Parser [Int]
+ip4Embedded = try (do colon2
+                      bs <- beforeEmbedded
+                      embedded <- ip4'
+                      format [] (bs ++ ip4ToIp6 embedded))
+              -- matches 2001:db8::192.0.2.1
+          <|> try (do bs1 <- manyTill (try $ hex <* char ':') (char ':')
+                      bs2 <- option [] beforeEmbedded
+                      embedded <- ip4'
+                      format bs1 (bs2 ++ ip4ToIp6 embedded))
+              -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1
+          <|> try (do bs <- beforeEmbedded
+                      embedded <- ip4'
+                      let rs = bs ++ ip4ToIp6 embedded
+                      check rs
+                      return rs)
+  where
+    beforeEmbedded = many $ try $ hex <* char ':'
+    ip4ToIp6 [a,b,c,d] = [ a `shiftL` 8 .|. b
+                         , c `shiftL` 8 .|. d ]
+    ip4ToIp6 _ = error "ip4ToIp6"
+    check bs = when (length bs /= 8) (fail "IPv6 address4")
+
 ----------------------------------------------------------------
 --
 -- HostAddress and HostAddress6
@@ -272,7 +311,7 @@
 
 -- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.
 fromHostAddress6 :: HostAddress6 -> IPv6
-fromHostAddress6 addr6 = IP6 addr6
+fromHostAddress6 = IP6
 
 -- | The 'toHostAddress6' function converts 'IPv6' to 'HostAddress6'.
 toHostAddress6 :: IPv6 -> HostAddress6
diff --git a/Data/IP/Op.hs b/Data/IP/Op.hs
--- a/Data/IP/Op.hs
+++ b/Data/IP/Op.hs
@@ -81,6 +81,6 @@
 -}
 makeAddrRange :: Addr a => a -> Int -> AddrRange a
 makeAddrRange ad len = AddrRange adr msk len
-   where
-     msk = intToMask len
-     adr = ad `masked` msk
+  where
+    msk = intToMask len
+    adr = ad `masked` msk
diff --git a/Data/IP/Range.hs b/Data/IP/Range.hs
--- a/Data/IP/Range.hs
+++ b/Data/IP/Range.hs
@@ -74,12 +74,11 @@
     readsPrec _ = parseIPRange
 
 parseIPRange :: String -> [(IPRange,String)]
-parseIPRange cs =
-  case runParser ip4range cs of
-       (Just ip,rest) -> [(IPv4Range ip,rest)]
-       (Nothing,_) -> case runParser ip6range cs of
-                           (Just ip,rest) -> [(IPv6Range ip,rest)]
-                           (Nothing,_) -> error $ "parseIPRange" ++ cs
+parseIPRange cs = case runParser ip4range cs of
+    (Just ip,rest) -> [(IPv4Range ip,rest)]
+    (Nothing,_)    -> case runParser ip6range cs of
+        (Just ip,rest) -> [(IPv6Range ip,rest)]
+        (Nothing,_) -> error $ "parseIPRange" ++ cs
 
 instance Read (AddrRange IPv4) where
     readsPrec _ = parseIPv4Range
diff --git a/Data/IP/RouteTable/Internal.hs b/Data/IP/RouteTable/Internal.hs
--- a/Data/IP/RouteTable/Internal.hs
+++ b/Data/IP/RouteTable/Internal.hs
@@ -110,31 +110,33 @@
   where
     tb1 = keyToTestBit k1
 insert k1 v1 s@(Node k2 tb2 v2 l r)
-    | k1 == k2  = Node k1 tb1 (Just v1) l r
-    | k2 >:> k1 = if isLeft k1 tb2
-                  then Node k2 tb2 v2 (insert k1 v1 l) r
-                  else Node k2 tb2 v2 l (insert k1 v1 r)
-    | k1 >:> k2 = if isLeft k2 tb1
-                  then Node k1 tb1 (Just v1) s Nil
-                  else Node k1 tb1 (Just v1) Nil s
-    | otherwise = let n = Node k1 tb1 (Just v1) Nil Nil
-                  in join n s
+  | k1 == k2  = Node k1 tb1 (Just v1) l r
+  | k2 >:> k1 = if isLeft k1 tb2 then
+                    Node k2 tb2 v2 (insert k1 v1 l) r
+                  else
+                    Node k2 tb2 v2 l (insert k1 v1 r)
+  | k1 >:> k2 = if isLeft k2 tb1 then
+                    Node k1 tb1 (Just v1) s Nil
+                  else
+                    Node k1 tb1 (Just v1) Nil s
+  | otherwise = let n = Node k1 tb1 (Just v1) Nil Nil
+                in join n s
   where
     tb1 = keyToTestBit k1
 
 join :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a
-join s1@(Node k1 _ _ _ _) s2@(Node k2 _ _ _ _) =
-    let kg = glue 0 k1 k2
-        tbg = keyToTestBit kg
-    in if isLeft k1 tbg
-       then Node kg tbg Nothing s1 s2
-       else Node kg tbg Nothing s2 s1
+join s1@(Node k1 _ _ _ _) s2@(Node k2 _ _ _ _)
+  | isLeft k1 tbg = Node kg tbg Nothing s1 s2
+  | otherwise     = Node kg tbg Nothing s2 s1
+  where
+    kg = glue 0 k1 k2
+    tbg = keyToTestBit kg
 join _ _ = error "join"
 
 glue :: (Routable k) => Int -> AddrRange k -> AddrRange k -> AddrRange k
 glue n k1 k2
-    | addr k1 `masked` mk == addr k2 `masked` mk = glue (n + 1) k1 k2
-    | otherwise = makeAddrRange (addr k1) (n - 1)
+  | addr k1 `masked` mk == addr k2 `masked` mk = glue (n + 1) k1 k2
+  | otherwise = makeAddrRange (addr k1) (n - 1)
   where
     mk = intToMask n
 
@@ -157,9 +159,10 @@
 delete _ Nil = Nil
 delete k1 s@(Node k2 tb2 v2 l r)
   | k1 == k2  = node k2 tb2 Nothing l r
-  | k2 >:> k1 = if isLeft k1 tb2
-                then node k2 tb2 v2 (delete k1 l) r
-                else node k2 tb2 v2 l (delete k1 r)
+  | k2 >:> k1 = if isLeft k1 tb2 then
+                    node k2 tb2 v2 (delete k1 l) r
+                  else
+                    node k2 tb2 v2 l (delete k1 r)
   | otherwise = s
 
 node :: (Routable k) => AddrRange k -> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
@@ -195,17 +198,19 @@
 search :: Routable k => AddrRange k -> IPRTable k a -> Maybe a -> Maybe a
 search _ Nil res = res
 search k1 (Node k2 tb2 Nothing l r) res
-    | k1 == k2  = res
-    | k2 >:> k1 = if isLeft k1 tb2
-                  then search k1 l res
-                  else search k1 r res
-    | otherwise = res
+  | k1 == k2  = res
+  | k2 >:> k1 = if isLeft k1 tb2 then
+                    search k1 l res
+                  else
+                    search k1 r res
+  | otherwise = res
 search k1 (Node k2 tb2 vl l r) res
-    | k1 == k2  = vl
-    | k2 >:> k1 = if isLeft k1 tb2
-                  then search k1 l vl
-                  else search k1 r vl
-    | otherwise = res
+  | k1 == k2  = vl
+  | k2 >:> k1 = if isLeft k1 tb2 then
+                    search k1 l vl
+                  else
+                    search k1 r vl
+  | otherwise = res
 
 ----------------------------------------------------------------
 
@@ -223,13 +228,13 @@
 findMatch :: MonadPlus m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
 findMatch _ Nil = mzero
 findMatch k1 (Node k2 _ Nothing l r)
-    | k1 >:> k2 = findMatch k1 l `mplus` findMatch k1 r
-    | k2 >:> k1 = findMatch k1 l `mplus` findMatch k1 r
-    | otherwise = mzero
+  | k1 >:> k2 = findMatch k1 l `mplus` findMatch k1 r
+  | k2 >:> k1 = findMatch k1 l `mplus` findMatch k1 r
+  | otherwise = mzero
 findMatch k1 (Node k2 _ (Just vl) l r)
-    | k1 >:> k2 = return (k2, vl) `mplus` findMatch k1 l `mplus` findMatch k1 r
-    | k2 >:> k1 = findMatch k1 l `mplus` findMatch k1 r
-    | otherwise = mzero
+  | k1 >:> k2 = return (k2, vl) `mplus` findMatch k1 l `mplus` findMatch k1 r
+  | k2 >:> k1 = findMatch k1 l `mplus` findMatch k1 r
+  | otherwise = mzero
 
 ----------------------------------------------------------------
 
diff --git a/iproute.cabal b/iproute.cabal
--- a/iproute.cabal
+++ b/iproute.cabal
@@ -1,5 +1,5 @@
 Name:                   iproute
-Version:                1.2.6
+Version:                1.2.7
 Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
 Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
 License:                BSD3