    module Bio.Sequence.SFF_name where

    import qualified Data.ByteString.Char8 as B
    import Data.ByteString.Char8 (ByteString, pack)
    import Data.Array.Unboxed
    import Data.Char (ord)

    -- | Read names encode various information, as per this struct.
    data ReadName = ReadName { date :: (Int,Int,Int)
                             , time :: (Int,Int,Int)
                             , region :: Int
                             , x_loc, y_loc :: Int } deriving Show

    -- ----------------------------------------------------------
    -- Decoding

    decodeReadName :: ByteString -> Maybe ReadName
    decodeReadName b = do t <- decodeDate $ B.take 6 b
                          r <- fst `fmap` (B.readInt $ B.take 2 $ B.drop 7 b)
                          l <- decodeLocation $ B.drop 9 b
                          return $ ReadName { date = (\[y,m,d] -> (y,m,d)) (take 3 t)
                                   , time = (\[hh,mm,ss] -> (hh,mm,ss)) (drop 3 t)
                                   , region = r
                                   , x_loc = fst l, y_loc = snd l }

    decodeLocation :: ByteString -> Maybe (Int,Int)
    decodeLocation l = (`divMod` 4096) `fmap` decode36 l

    decodeDate :: ByteString -> Maybe [Int]
    decodeDate d    = (fixyear . reverse . (`divMods` [60,60,24,32,13])) =<< decode36 d
        where fixyear (i:is) = Just (2000+i:is)
              fixyear []     = Nothing

    -- ----------------------------------------------------------
    -- Encoding

    encodeReadName :: ReadName -> ByteString
    encodeReadName r =  B.concat [ encodeDate (date r) (time r)
                                 , encodeRegion (region r)
                                 , encodeLocation (x_loc r) (y_loc r)]

    encodeLocation :: Int -> Int -> ByteString
    encodeLocation = undefined

    encodeRegion :: Int -> ByteString
    encodeRegion = undefined

    encodeDate :: (Int,Int,Int) -> (Int,Int,Int) -> ByteString
    encodeDate = undefined

    -- ----------------------------------------------------------

    divMods :: Int -> [Int] -> [Int]
    divMods x (i:is) = let (a,b) = x `divMod` i
                       in b : divMods a is
    divMods x [] = [x]

    -- ----------------------------------------------------------
    -- Decoding base36 strings

    decode36 :: ByteString -> Maybe Int
    decode36 s = (foldr1 (\a b -> b*36+a) . reverse) `fmap` (mapM decCh . B.unpack $ s)

    {-
    decode36' = dec 0
        where dec i b = case uncons b of Just (c,rest) -> dec (i*36+fromJust (decCh c)) rest
                                         Nothing       -> i
              fromJust (Just z) = z
    -}

    decCh :: Char -> Maybe Int
    decCh x | x >= 'A' && x <= 'Z' = Just (ord x - ord 'A')
            | x >= '0' && x <= '9' = Just (26 + ord x - ord '0')
            | otherwise            = Nothing -- error ("decode36: can't decode "++show x)

    encode36 :: Int -> ByteString
    encode36 = pack . map (b36!) . reverse . enc
        where
          enc 0 = []
          enc i = let (a,b) = i `divMod` 36
                  in b : enc a

    b36 :: UArray Int Char
    b36 = listArray (0,35) (['A'..'Z']++['0'..'9'])