{-# LANGUAGE ForeignFunctionInterface #-}

{-|
Description:    Miscellaneous utility functions, of limited utility.

Copyright:      (c) 2018-2021 Sam May
License:        GPL-3.0-or-later
Maintainer:     ag@eitilt.life

Stability:      stable
Portability:    non-portable (requires libcdio)

Most functions defined by the C header either encapsulate math to perform on
an object or the system state, or edit `String's in some (barring allocations)
pure manner, including a few with general utility rather than being specific to
libcdio.  However, most are also restricted to internal use, and not provided
as symbols exported by the library itself; those internal functions are still
present in the Haskell source as well, for anyone interested.  As such, this
module and the functions it provides should rarely need to be used.


= @util.h@

== Defines
* @CDIO_FREE_IF_NOT_NULL@           (removed; Haskell handles its own memory management)
* @CLAMP@                           (removed; preprocessor logic isn't required in Haskell)
* @IN@                              (removed; preprocessor logic isn't required in Haskell)
* @MAX@                             (removed; preprocessor logic isn't required in Haskell)
* @MAX@                             (removed; preprocessor logic isn't required in Haskell)

== Symbols
* @_cdio_strfreev@                  (removed; list is automatically freed)
* @_cdio_strsplit@                  -> 'Foreign.Libcdio.Util.strsplit'
* @cdio_from_bcd8@                  -> 'Foreign.Libcdio.Util.fromBcd8'
* @cdio_realpath@                   -> 'Foreign.Libcdio.Util.realpath'
* @cdio_to_bcd8@                    -> 'Foreign.Libcdio.Util.toBcd8'
-}
module Foreign.Libcdio.Util
    ( Bcd
    , toBcd8, fromBcd8
    , strsplit
    , realpath
    ) where


{- Used only by not exported symbols
import qualified Foreign.ForeignPtr as C

import qualified Foreign.Marshal.Alloc as M
import qualified Foreign.Marshal.Array as M
import qualified Foreign.Marshal.Utils as M

import qualified System.IO.Unsafe as IO.Unsafe

import Foreign.Libcdio.Types.Internal
-}

import qualified Data.Word as W


import qualified Data.Ix as I

import qualified Foreign.C.String as C
import qualified Foreign.C.Types as C
import qualified Foreign.Ptr as C

import qualified Foreign.Marshal.Utils as M
import qualified Foreign.Storable as S

import qualified Numeric as NM

import qualified Text.Printf as P


import Foreign.Libcdio.Marshal


{- Not exported
-- | Calculate how many blocks of a given size are required to contain the
-- given number of bytes.
len2blocks
    :: W.Word32
        -- ^ The number of bytes to fit.
    -> W.Word16
        -- ^ The size of each block.
    -> Lsn
len2blocks b s = fromIntegral $ len2blocks' (fromIntegral b) (fromIntegral s)

foreign import ccall safe "cdio/util.h _cdio_len2blocks"
  len2blocks' :: C.CUInt -> C.CUShort -> C.CInt

-- | Round up to the next block boundery after a given offset.
ceil2block
    :: Int
        -- ^ The base address to round.
    -> W.Word16
        -- ^ The size of each block.
    -> Int
ceil2block p s = fromIntegral $ ceil2block' (fromIntegral p) (fromIntegral s)

foreign import ccall safe "cdio/util.h _cdio_ceil2block"
  ceil2block' :: C.CInt -> C.CUShort -> C.CInt


-- | Add a given length after a given address, potentially putting it at the
-- start of a new block if there is not enough space remaining in the one in
-- which the address is located.
ofsAdd
    :: Int
        -- ^ The base addres.
    -> Int
        -- ^ The number of bytes to add.
    -> W.Word16
        -- ^ The size of each block.
    -> Int
ofsAdd p a s = fromIntegral $ ofsAdd' (fromIntegral p) (fromIntegral a) (fromIntegral s)

foreign import ccall safe "cdio/util.h _cdio_ofs_add"
  ofsAdd' :: C.CInt -> C.CInt -> C.CUShort -> C.CInt


-- | Print a 'True'/'False' value as "yes"/"no".
--
-- A similar, but not identical, result may be obtained with 'show'.
boolStr :: Bool -> String
boolStr = IO.Unsafe.unsafePerformIO . C.peekCString . boolStr' . M.fromBool

foreign import ccall safe "cdio/util.h _cdio_bool_str"
  boolStr' :: C.CInt -> C.CString


-- | Copy the contents of one memory address to another, newly allocated one.
memdup :: C.Ptr a -> Word
    -> IO (Maybe (C.ForeignPtr a))
        -- ^ 'Nothing' if the source is 'nullPtr',
                                    -- or a pointer to the new memory.
memdup p s = do
    p' <- memdup' p (fromIntegral s)
    if p == C.nullPtr
    then return Nothing
    else Just <$> C.newForeignPtr cdioFreePtr p'

foreign import ccall safe "cdio/util.h _cdio_memdup"
  memdup' :: C.Ptr a -> C.CSize -> IO (C.Ptr a)


-- | Create a copy of a string with all characters transformed to upper case.
--
-- This should be functionally identical to @map toUpper@.
strdupUpper :: String -> IO String
strdupUpper s = C.withCString s strdupUpper' >>= peekFString

foreign import ccall safe "cdio/util.h _cdio_strdup_upper"
  strdupUpper' :: C.CString -> IO C.CString

-- | Duplicate a path and make it platform compliant.  Typically needed for
-- MinGW\/MSYS where a "\/c\/..." path must be translated to "c:\/...".
strdupFixpath :: String -> IO (Maybe String)
strdupFixpath s = C.withCString s strdupFixpath' >>= peekNullFString

foreign import ccall safe "cdio/util.h _cdio_strdup_fixpath"
  strdupFixpath' :: C.CString -> IO C.CString


-- | Count the number of C-style string pointers in a NULL-terminated array.
--
-- As we are already know the list is fully populated, this offers no benefit
-- over 'length'; Haskell's type system will not insert anything acting like a
-- string which is actually @NULL@.
strlenv :: [String] -> IO Word
strlenv ss = M.withMany C.withCString ss $ \ss' ->
    fromIntegral <$> M.withArray0 C.nullPtr ss' strlenv'

foreign import ccall safe "cdio/util.h _cdio_strlenv"
  strlenv' :: C.Ptr C.CString -> IO C.CSize
-}


-- | Return the substrings between a given delimiter, dropping any empty ones.
--
-- The Haskell repositories provide this via
-- [split](https://hackage.haskell.org/package/split).
--
-- > strsplit str d == Data.List.Split.wordsBy (== d) str
strsplit :: String -> Char -> IO [String]
strsplit :: String -> Char -> IO [String]
strsplit String
s Char
c = String -> (CString -> IO (Ptr CString)) -> IO (Ptr CString)
forall a. String -> (CString -> IO a) -> IO a
C.withCString String
s ((CString -> CChar -> IO (Ptr CString))
-> CChar -> CString -> IO (Ptr CString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CString -> CChar -> IO (Ptr CString)
strsplit' (CChar -> CString -> IO (Ptr CString))
-> (Int -> CChar) -> Int -> CString -> IO (Ptr CString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CString -> IO (Ptr CString))
-> Int -> CString -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) IO (Ptr CString) -> (Ptr CString -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CString -> IO [String]
peekFStringArray

foreign import ccall safe "cdio/util.h _cdio_strsplit"
  strsplit' :: C.CString -> C.CChar -> IO (C.Ptr C.CString)


-- | A bitwise encoding where the lower four bits encode a number modulo 10,
-- and the upper encode the same divided by 10.
newtype Bcd = Bcd W.Word8
instance Eq Bcd where
    Bcd
a == :: Bcd -> Bcd -> Bool
== Bcd
b = Bcd -> Word
fromBcd8 Bcd
a Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Bcd -> Word
fromBcd8 Bcd
b
instance Ord Bcd where
    compare :: Bcd -> Bcd -> Ordering
compare Bcd
a Bcd
b = Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Bcd -> Word
fromBcd8 Bcd
a) (Bcd -> Word
fromBcd8 Bcd
b)
instance Show Bcd where
    showsPrec :: Int -> Bcd -> ShowS
showsPrec Int
p i :: Bcd
i@(Bcd Word8
w)
        | Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
mod Word8
w Word8
0x10 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xA = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
application) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString (String
"Bcd 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pad) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
NM.showHex Word8
w
        | Bool
otherwise = Int -> Word -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Word -> ShowS) -> Word -> ShowS
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
i
      where application :: Int
application = Int
10
            pad :: String
pad | Bcd
i Bcd -> Bcd -> Bool
forall a. Ord a => a -> a -> Bool
>= Bcd
0x10 = String
""
                | Bool
otherwise = String
"0"
instance Read Bcd where
    readsPrec :: Int -> ReadS Bcd
readsPrec Int
p String
s =
           ((Word, String) -> (Bcd, String))
-> [(Word, String)] -> [(Bcd, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Word, String) -> (Bcd, String)
forall b. (Word, b) -> (Bcd, b)
toBcd8Fst (Int -> ReadS Word
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s)
        [(Bcd, String)] -> [(Bcd, String)] -> [(Bcd, String)]
forall a. [a] -> [a] -> [a]
++ Bool -> ReadS Bcd -> ReadS Bcd
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
application)
            (\String
r -> [ (Word8 -> Bcd
Bcd Word8
i, String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
u)
                   | (String
"Bcd", String
t) <- ReadS String
lex String
r
                   , (Char
'0':Char
'x':String
l, String
u) <- ReadS String
lex String
t
                   , (Word8
i, String
v) <- ReadS Word8
forall a. (Eq a, Num a) => ReadS a
NM.readHex String
l
                   ]) String
s
      where toBcd8Fst :: (Word, b) -> (Bcd, b)
toBcd8Fst (Word
w, b
b) = (Word -> Bcd
toBcd8 Word
w, b
b)
            application :: Int
application = Int
10
-- | >>> map fromBcd8 [minBound, maxBound]
-- [0, 159]
instance Bounded Bcd where
    minBound :: Bcd
minBound = Word8 -> Bcd
Bcd Word8
0
    maxBound :: Bcd
maxBound = Word8 -> Bcd
Bcd Word8
0xF9
instance Enum Bcd where
    toEnum :: Int -> Bcd
toEnum Int
i = Word -> Bcd
toBcd8 (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
i
    fromEnum :: Bcd -> Int
fromEnum Bcd
b = Word -> Int
forall a. Enum a => a -> Int
fromEnum (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
b
    succ :: Bcd -> Bcd
succ Bcd
i
        | Bcd
i Bcd -> Bcd -> Bool
forall a. Ord a => a -> a -> Bool
>= Bcd
forall a. Bounded a => a
maxBound = String -> Bcd
forall a. HasCallStack => String -> a
error String
"Enum.succ(Bcd): tried to take `succ' of maxBound"
        | Bool
otherwise = Word -> Bcd
toBcd8 (Word -> Bcd) -> (Word -> Word) -> Word -> Bcd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word
forall a. Enum a => a -> a
succ (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
i
    pred :: Bcd -> Bcd
pred Bcd
i
        | Bcd
i Bcd -> Bcd -> Bool
forall a. Ord a => a -> a -> Bool
<= Bcd
forall a. Bounded a => a
minBound = String -> Bcd
forall a. HasCallStack => String -> a
error String
"Enum.pred(Bcd): tried to take `pred' of minBound"
        | Bool
otherwise = Word -> Bcd
toBcd8 (Word -> Bcd) -> (Word -> Word) -> Word -> Bcd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word
forall a. Enum a => a -> a
pred (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
i
instance I.Ix Bcd where
    range :: (Bcd, Bcd) -> [Bcd]
range (Bcd
a, Bcd
b) = (Word -> Bcd) -> [Word] -> [Bcd]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Bcd
toBcd8 ([Word] -> [Bcd]) -> [Word] -> [Bcd]
forall a b. (a -> b) -> a -> b
$ (Word, Word) -> [Word]
forall a. Ix a => (a, a) -> [a]
I.range (Bcd -> Word
fromBcd8 Bcd
a, Bcd -> Word
fromBcd8 Bcd
b)
    inRange :: (Bcd, Bcd) -> Bcd -> Bool
inRange (Bcd
a, Bcd
b) Bcd
i = (Word, Word) -> Word -> Bool
forall a. Ix a => (a, a) -> a -> Bool
I.inRange (Bcd -> Word
fromBcd8 Bcd
a, Bcd -> Word
fromBcd8 Bcd
b) (Word -> Bool) -> Word -> Bool
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
i
    index :: (Bcd, Bcd) -> Bcd -> Int
index (Bcd
a, Bcd
b) Bcd
i = (Word, Word) -> Word -> Int
forall a. Ix a => (a, a) -> a -> Int
I.index (Bcd -> Word
fromBcd8 Bcd
a, Bcd -> Word
fromBcd8 Bcd
b) (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
i
instance Num Bcd where
    Bcd
a + :: Bcd -> Bcd -> Bcd
+ Bcd
b = Word -> Bcd
toBcd8 (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Bcd -> Word
fromBcd8 Bcd
b
    Bcd
a - :: Bcd -> Bcd -> Bcd
- Bcd
b = Word -> Bcd
toBcd8 (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
a Word -> Word -> Word
forall a. Num a => a -> a -> a
- Bcd -> Word
fromBcd8 Bcd
b
    Bcd
a * :: Bcd -> Bcd -> Bcd
* Bcd
b = Word -> Bcd
toBcd8 (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
a Word -> Word -> Word
forall a. Num a => a -> a -> a
* Bcd -> Word
fromBcd8 Bcd
b
    abs :: Bcd -> Bcd
abs Bcd
i = Bcd
i
    signum :: Bcd -> Bcd
signum Bcd
b = Word -> Bcd
toBcd8 (Word -> Bcd) -> (Word -> Word) -> Word -> Bcd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word
forall a. Num a => a -> a
signum (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
b
    fromInteger :: Integer -> Bcd
fromInteger Integer
i = Word -> Bcd
toBcd8 (Word -> Bcd) -> Word -> Bcd
forall a b. (a -> b) -> a -> b
$ Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
instance Real Bcd where
    toRational :: Bcd -> Rational
toRational Bcd
b = Word -> Rational
forall a. Real a => a -> Rational
toRational (Word -> Rational) -> Word -> Rational
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
b
instance Integral Bcd where
    quotRem :: Bcd -> Bcd -> (Bcd, Bcd)
quotRem Bcd
dividend Bcd
divisor = (Word -> Bcd
toBcd8 Word
q, Word -> Bcd
toBcd8 Word
r)
      where (Word
q, Word
r) = Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
quotRem (Bcd -> Word
fromBcd8 Bcd
dividend) (Bcd -> Word
fromBcd8 Bcd
divisor)
    toInteger :: Bcd -> Integer
toInteger Bcd
b = Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Integer) -> Word -> Integer
forall a b. (a -> b) -> a -> b
$ Bcd -> Word
fromBcd8 Bcd
b
instance P.PrintfArg Bcd where
    formatArg :: Bcd -> FieldFormatter
formatArg = Word -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
P.formatArg (Word -> FieldFormatter) -> (Bcd -> Word) -> Bcd -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bcd -> Word
fromBcd8
instance S.Storable Bcd where
    sizeOf :: Bcd -> Int
sizeOf (Bcd Word8
i)    = Word8 -> Int
forall a. Storable a => a -> Int
S.sizeOf Word8
i
    alignment :: Bcd -> Int
alignment (Bcd Word8
i) = Word8 -> Int
forall a. Storable a => a -> Int
S.alignment Word8
i
    peek :: Ptr Bcd -> IO Bcd
peek Ptr Bcd
p            = Word8 -> Bcd
Bcd (Word8 -> Bcd) -> IO Word8 -> IO Bcd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek (Ptr Bcd -> Ptr Word8
forall a b. Ptr a -> Ptr b
C.castPtr Ptr Bcd
p)
    poke :: Ptr Bcd -> Bcd -> IO ()
poke Ptr Bcd
p (Bcd Word8
i)    = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr Bcd -> Ptr Word8
forall a b. Ptr a -> Ptr b
C.castPtr Ptr Bcd
p) Word8
i

-- | Encode a number according to the libcdio BCD encoding.  If the value is
-- greater than @'maxBound' :: 'Bcd'@, it wraps back around to @0@.
toBcd8 :: Word -> Bcd
toBcd8 :: Word -> Bcd
toBcd8 = Word8 -> Bcd
Bcd (Word8 -> Bcd) -> (Word -> Word8) -> Word -> Bcd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word8) -> (Word -> CUInt) -> Word -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CUInt
toBcd8' (CUInt -> CUInt) -> (Word -> CUInt) -> Word -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

foreign import ccall safe "cdio/util.h cdio_to_bcd8"
  toBcd8' :: C.CUInt -> C.CUInt

-- | Decode a number in the libcdio BCD encoding.
fromBcd8 :: Bcd -> Word
fromBcd8 :: Bcd -> Word
fromBcd8 (Bcd Word8
i) = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word) -> (CUInt -> CUInt) -> CUInt -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CUInt
fromBcd8' (CUInt -> Word) -> CUInt -> Word
forall a b. (a -> b) -> a -> b
$ Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

foreign import ccall safe "cdio/util.h cdio_from_bcd8"
  fromBcd8' :: C.CUInt -> C.CUInt


-- | Same as POSIX.1-2001 realpath, if the system provides it.  If not,
-- libcdio's "poor-man's simulation" of its behavior.
--
-- The Haskell repositories provide a similar alternative in
-- @System.Directory.canonicalizePath@ from
-- [directory](https://hackage.haskell.org/package/directory).
realpath :: String -> IO (Maybe String)
realpath :: String -> IO (Maybe String)
realpath String
s = String -> (CString -> IO CString) -> IO CString
forall a. String -> (CString -> IO a) -> IO a
C.withCString String
s (CString -> CString -> IO CString
`realpath'` CString
forall a. Ptr a
C.nullPtr) IO CString -> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO String) -> CString -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek CString -> IO String
peekFString

foreign import ccall safe "cdio/util.h cdio_realpath"
  realpath' :: C.CString -> C.CString -> IO C.CString


{- Pointer logic is not exposed.
-- | Some function which matches the free() prototype.
type DataFree = C.FunPtr (C.Ptr () -> IO ())
-}