module System.Linux.Btrfs.UUID
    ( UUID(..)
    , toString
    , fromString
    ) where

import Data.Word (Word64)
import Data.Word.Endian (BE64(..))
import Data.Bits ((.&.), unsafeShiftR)
import Text.Printf (printf)

import Foreign.Storable (Storable(..))
import Foreign.Ptr (castPtr)
import Foreign.C.Types (CInt)

data UUID = UUID Word64 Word64
  deriving (UUID -> UUID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
Eq, Eq UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmax :: UUID -> UUID -> UUID
>= :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c< :: UUID -> UUID -> Bool
compare :: UUID -> UUID -> Ordering
$ccompare :: UUID -> UUID -> Ordering
Ord)

instance Show UUID where
    showsPrec :: Int -> UUID -> ShowS
showsPrec Int
p UUID
u =
        Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
9) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"fromString " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (UUID -> String
toString UUID
u)

-- | A @UUID@ is stored as two big-endian 'Word64's.
instance Storable UUID where
    sizeOf :: UUID -> Int
sizeOf UUID
_ = Int
16
    alignment :: UUID -> Int
alignment UUID
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: CInt)
    peek :: Ptr UUID -> IO UUID
peek Ptr UUID
ptr = do
        BE64 Word64
h  <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr UUID
ptr)
        BE64 Word64
l  <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr UUID
ptr Int
8
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> UUID
UUID Word64
h Word64
l
    poke :: Ptr UUID -> UUID -> IO ()
poke Ptr UUID
ptr (UUID Word64
h Word64
l) = do
        forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr UUID
ptr) (Word64 -> BE64
BE64 Word64
h)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr UUID
ptr Int
8 (Word64 -> BE64
BE64 Word64
l)

toString :: UUID -> String
toString :: UUID -> String
toString (UUID Word64
h Word64
l) = forall r. PrintfType r => String -> r
printf String
"%.8x-%.4x-%.4x-%.4x-%.12x" Word64
h1 Word64
h2 Word64
h3 Word64
l1 Word64
l2
  where
    h1 :: Word64
h1 = (Word64
h forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff00000000) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32
    h2 :: Word64
h2 = (Word64
h forall a. Bits a => a -> a -> a
.&.         Word64
0xffff0000) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16
    h3 :: Word64
h3 = (Word64
h forall a. Bits a => a -> a -> a
.&.             Word64
0xffff)
    l1 :: Word64
l1 = (Word64
l forall a. Bits a => a -> a -> a
.&. Word64
0xffff000000000000) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
48
    l2 :: Word64
l2 = (Word64
l forall a. Bits a => a -> a -> a
.&.     Word64
0xffffffffffff)

fromString :: String -> Maybe UUID
fromString :: String -> Maybe UUID
fromString String
s
    | String -> Bool
isValidUUID String
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> UUID
UUID Word64
h Word64
l
    | Bool
otherwise = forall a. Maybe a
Nothing
  where
    h :: Word64
h = forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Char
'0' forall a. a -> [a] -> [a]
: Char
'x' forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
16 String
s'
    l :: Word64
l = forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Char
'0' forall a. a -> [a] -> [a]
: Char
'x' forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
16 String
s'
    s' :: String
s' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'-') String
s

isValidUUID :: String -> Bool
isValidUUID :: String -> Bool
isValidUUID String
s = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Eq a => a -> a -> Bool
== Int
36 Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Char -> Bool
checkChar [Int
0..] String
s)
  where
    checkChar :: Int -> Char -> Bool
checkChar Int
i Char
c =
        if Int
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
hyphenPosns then
            Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
        else
            (Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
|| (Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f')Bool -> Bool -> Bool
|| (Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F')
    hyphenPosns :: [Int]
hyphenPosns = [Int
8, Int
13, Int
18, Int
23] :: [Int]