{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Passman.Core.Internal.Util
-- Copyright   : Matthew Harm Bekkema 2016
-- License     : GPL-2
-- Maintainer  : mbekkema97@gmail.com
-- Stability   : experimental
-- Portability : POSIX
-----------------------------------------------------------------------------

module Passman.Core.Internal.Util
( strip
, fileMap
, unmapFile
, lEitherToMaybe
, fromBase
, toBase
, bytesToInt
, zeroPadL
, splitOn
, bsPack
, bsUnpack
) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Char (isSpace)
import Data.List (dropWhileEnd, findIndex)
import Data.Maybe (fromJust)
import Passman.Core.Internal.Compat (Natural)
import Control.Applicative ((<$>))

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn x = foldr helper []
  where
    helper y (a:as) = if y == x then []:(a:as) else (y:a):as
    helper y [] = if y == x then [[],[]] else [[y]]

strip :: String -> String
strip = dropWhileEnd isSpace . dropWhile isSpace

fileMap :: (String -> a) -> FilePath -> IO [a]
fileMap f filename = map f <$> lines <$> readFile filename

bytesToInt :: Integral a => ByteString -> a
bytesToInt = helper . BS.reverse
  where
    helper :: Integral a => ByteString -> a
    helper x = case BS.uncons x of
        Nothing -> 0
        Just (c,cs) -> fromIntegral (fromEnum c) + 256 * helper cs

fromBase :: Natural -> [Natural] -> Natural
fromBase b = helper . reverse
  where
    helper :: [Natural] -> Natural
    helper (k:ks) = k + b * helper ks
    helper []     = 0

toBase :: Natural -> Natural -> [Natural]
toBase 0 _ = error "Base 0"
toBase 1 _ = error "Base 1"
toBase b k = toBase_helper (digitsInBase b k) b k

toBase_helper :: Natural -> Natural -> Natural -> [Natural]
toBase_helper 0 _ k = [k]
toBase_helper n b k = d:toBase_helper (n-1) b m
  where
    (d,m) = divMod k (b^n)

digitsInBase :: Natural -> Natural -> Natural
digitsInBase b k = fromIntegral $ fromJust $ findIndex (>k) [b^n | n <- [start..]]
  where start = 1 :: Natural

zeroPadL :: Int -> [Natural] -> [Natural]
zeroPadL l xs = replicate (l - length xs) 0 ++ xs

bsPack :: String -> ByteString
bsPack = encodeUtf8 . T.pack

bsUnpack :: ByteString -> String
bsUnpack = T.unpack . decodeUtf8

lEitherToMaybe :: Either a () -> Maybe a
lEitherToMaybe (Right ()) = Nothing
lEitherToMaybe (Left x)   = Just x

unmapFile :: (a -> String) -> [a] -> FilePath -> IO ()
unmapFile f xs fn = writeFile fn $ unlines $ map f xs