{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE PatternSynonyms #-}
-- | Implementation of proquints according to https://arxiv.org/html/0901.4016
module Proquint
( word16ToProquint
, proquintToWord16
) where

import Control.Applicative (liftA2)
import Data.Bits ((.&.), (.|.), unsafeShiftR, (!<<.))
import Data.Word (Word16)
import Data.Ix (inRange)

import Data.Array.Unboxed (UArray, listArray, accumArray, (!), bounds)

-- Bitmasks
-----------

-- Consonants define 4 bits
cMask :: Word16
cMask = 0b0000000000001111
-- Vowels define 2 bits
vMask :: Word16
vMask = 0b0000000000000011

-- Lookup tables
----------------

-- Maps from right-shifted portions of 'Word16' to their 'Char' representations
consonants :: UArray Word16 Char
consonants = listArray (0,15) "bdfghjklmnprstvz"
vowels :: UArray Word16 Char
vowels = listArray (0,3) "aiou"

-- Inverse maps, using Nil for unused letters in the range, such as 'c' and 'e'
pattern Nil :: Word16
pattern Nil = 0b1111111111111111
consonants' :: UArray Char Word16
consonants' = accumArray (\_ e -> e) Nil ('b', 'z') $ (\i -> (consonants ! i, i)) <$> [0..15]
vowels' :: UArray Char Word16
vowels' = accumArray (\_ e -> e) Nil ('a', 'u') $ (\i -> (vowels ! i, i)) <$> [0..3]

-- Reverse lookup, from character to the bits it represents
revLookup :: UArray Char Word16 -> Char -> Maybe Word16
revLookup a i | inRange (bounds a) i = case a ! i of
                                         Nil -> Nothing
                                         w -> Just w
              | otherwise = Nothing

-- Conversion
-------------

-- | Convert a 16-bit number to its proquint representation
--
-- >>> word16ToProquint 42659
-- "pipog"
word16ToProquint :: Word16 -> String
word16ToProquint word = [c1,v1,c2,v2,c3]
  where
    c1 = consonants ! fromIntegral (cMask .&. unsafeShiftR word 12)
    v1 = vowels     ! fromIntegral (vMask .&. unsafeShiftR word 10)
    c2 = consonants ! fromIntegral (cMask .&. unsafeShiftR word 6 )
    v2 = vowels     ! fromIntegral (vMask .&. unsafeShiftR word 4 )
    c3 = consonants ! fromIntegral (cMask .&.              word   )

-- | Convert a proquint representation back into a 16-bit number, if possible
--
-- >>> proquintToWord16 "pipog"
-- Just 42659
-- >>> proquintToWord16 ""
-- Nothing
-- >>> proquintToWord16 "bababab"
-- Nothing
-- >>> proquintToWord16 "cecec"
-- Nothing
proquintToWord16 :: String -> Maybe Word16
proquintToWord16 [c1,v1,c2,v2,c3] = foldr (liftA2 (.|.))
  (revLookup consonants' c3)
  [ (!<<. 12) <$> revLookup consonants' c1
  , (!<<. 10) <$> revLookup vowels' v1
  , (!<<. 6 ) <$> revLookup consonants' c2
  , (!<<. 4 ) <$> revLookup vowels' v2
  ]
proquintToWord16 _ = Nothing