{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists  #-}

module UTF8 where

import Data.Word ( Word8 )
import Data.Bits ( (.&.), shiftR )
import Data.Char ( ord )

import qualified Data.List.NonEmpty as List1
type List1 = List1.NonEmpty

{-
-- Could also be imported:

import Codec.Binary.UTF8.Light as UTF8

encode :: Char -> [Word8]
encode c = head (UTF8.encodeUTF8' [UTF8.c2w c])

-}

-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
encode :: Char -> List1 Word8
encode :: Char -> List1 Word8
encode = (Int -> Word8) -> NonEmpty Int -> List1 Word8
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NonEmpty Int -> List1 Word8)
-> (Char -> NonEmpty Int) -> Char -> List1 Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NonEmpty Int
Item (NonEmpty Int) -> NonEmpty Int
forall {l}.
(Ord (Item l), Num (Item l), IsList l, Bits (Item l)) =>
Item l -> l
go (Int -> NonEmpty Int) -> (Char -> Int) -> Char -> NonEmpty Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
 where
  go :: Item l -> l
go Item l
oc
   | Item l
oc Item l -> Item l -> Bool
forall a. Ord a => a -> a -> Bool
<= Item l
0x7f       = [Item l
oc]

   | Item l
oc Item l -> Item l -> Bool
forall a. Ord a => a -> a -> Bool
<= Item l
0x7ff      = [ Item l
0xc0 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ (Item l
oc Item l -> Int -> Item l
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
                        , Item l
0x80 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ Item l
oc Item l -> Item l -> Item l
forall a. Bits a => a -> a -> a
.&. Item l
0x3f
                        ]

   | Item l
oc Item l -> Item l -> Bool
forall a. Ord a => a -> a -> Bool
<= Item l
0xffff     = [ Item l
0xe0 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ (Item l
oc Item l -> Int -> Item l
forall a. Bits a => a -> Int -> a
`shiftR` Int
12)
                        , Item l
0x80 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ ((Item l
oc Item l -> Int -> Item l
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Item l -> Item l -> Item l
forall a. Bits a => a -> a -> a
.&. Item l
0x3f)
                        , Item l
0x80 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ Item l
oc Item l -> Item l -> Item l
forall a. Bits a => a -> a -> a
.&. Item l
0x3f
                        ]
   | Bool
otherwise        = [ Item l
0xf0 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ (Item l
oc Item l -> Int -> Item l
forall a. Bits a => a -> Int -> a
`shiftR` Int
18)
                        , Item l
0x80 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ ((Item l
oc Item l -> Int -> Item l
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Item l -> Item l -> Item l
forall a. Bits a => a -> a -> a
.&. Item l
0x3f)
                        , Item l
0x80 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ ((Item l
oc Item l -> Int -> Item l
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Item l -> Item l -> Item l
forall a. Bits a => a -> a -> a
.&. Item l
0x3f)
                        , Item l
0x80 Item l -> Item l -> Item l
forall a. Num a => a -> a -> a
+ Item l
oc Item l -> Item l -> Item l
forall a. Bits a => a -> a -> a
.&. Item l
0x3f
                        ]