import Data.Word (Word16)

-- Note : calls into the Win32 API using this
-- FilePath representation must use the unicode
-- versions of functions

-- everything in WCHAR unicode
-- cannot contain the characters
-- '<' '>' ':' '"' '/' '\' '|'
type WinPathSeg  = [Word16] 

-- type WinPathSeg = String -- would work if Haskell strings
                            -- _actually_ supported unicode

type GUID = WinPathSeg -- perhaps should be something else ?

data WinCommDevice 
   = CON  | PRN  | AUX  | NUL 
   | COM1 | COM2 | COM3 | COM4
   | COM5 | COM6 | COM7 | COM8 
   | COM9 | LPT1 | LPT2 | LPT3
   | LPT4 | LPT5 | LPT6 | LPT7
   | LPT8 | LPT9 | CLOCK_DOLLAR
 deriving (Eq,Ord)

data MailslotDest
   = MailslotDestLocalhost
   | MailslotDestNamed WinPathSeg
   | MailslotDestWildcard
 deriving (Eq,Ord)

-- INVARIANT the path list is never empty
data WinPath       -- drive        path         NTFS filestream name and type
   = WinAbsPath       (Maybe Char) [WinPathSeg] (Maybe (WinPathSeg,WinPathSeg))
   | WinRelPath       (Maybe Char) [WinPathSeg] (Maybe (WinPathSeg,WinPathSeg))
   | WinPhysicalPath  Int
   | WinVolumePath    (Either Char GUID)
   | WinTapePath      Int
   | WinCommPath      WinCommDevice
   | WinMailslotPath  MailslotDest [WinPathSeg]
   | WinNamedPipePath WinPathSeg
 deriving (Eq,Ord)

winPathSeparator :: Char
winPathSeparator = '\\'

winCurrentDirSeg :: WinPathSeg
winCurrentDirSeg = map (fromIntegral . fromEnum) "."

winParentDirSeg :: WinPathSeg
winParentDirSeg = map (fromIntegral . fromEnum) ".."

showWinCommDevice :: WinCommDevice -> String
showWinCommDevice CON   = "CON"
showWinCommDevice PRN   = "PRN"
showWinCommDevice AUX   = "AUX"
showWinCommDevice NUL   = "NUL"
showWinCommDevice COM1  = "COM1"
showWinCommDevice COM2  = "COM2"
showWinCommDevice COM3  = "COM3"
showWinCommDevice COM4  = "COM4"
showWinCommDevice COM5  = "COM5"
showWinCommDevice COM6  = "COM6"
showWinCommDevice COM7  = "COM7"
showWinCommDevice COM8  = "COM8"
showWinCommDevice COM9  = "COM9"
showWinCommDevice LPT1  = "LPT1"
showWinCommDevice LPT2  = "LPT2"
showWinCommDevice LPT3  = "LPT3"
showWinCommDevice LPT4  = "LPT4"
showWinCommDevice LPT5  = "LPT5"
showWinCommDevice LPT6  = "LPT6"
showWinCommDevice LPT7  = "LPT7"
showWinCommDevice LPT8  = "LPT8"
showWinCommDevice LPT9  = "LPT9"
showWinCommDevice CLOCK_DOLLAR = "CLOCK$"

showMailslotDest :: MailslotDest -> String
showMailslotDest MailslotDestLocalhost = "."
showMailslotDest MailslotDestWildcard  = "*"
showMailslotDest (MailslotDestNamed x) = showWinPathSeg x

showWinPathSeg :: WinPathSeg -> String
showWinPathSeg = map (toEnum . fromIntegral)

showWinPath :: WinPath -> String
showWinPath (WinAbsPath drive segs streamname) =
   let driveStr  = case drive of  
                        Nothing -> ""
                        Just c  -> c : ":"
       pathStr   = foldl (\p s -> winPathSeparator : (showWinPathSeg s) ++ p) "" segs
       streamStr = case streamname of
                        Nothing -> ""
                        Just (n,t) -> concat [":",showWinPathSeg n
					     ,":",showWinPathSeg t]
   in concat [driveStr,pathStr,streamStr]

showWinPath (WinRelPath drive segs streamname) =
   let driveStr  = case drive of  
                        Nothing -> ""
                        Just c  -> c : ":"
       pathStr   = tail $ foldl (\p s -> winPathSeparator : (showWinPathSeg s) ++ p) "" segs
       streamStr = case streamname of
                        Nothing -> ""
                        Just (n,t) -> concat [":",showWinPathSeg n
					     ,":",showWinPathSeg t]
   in concat [driveStr,pathStr,streamStr]

showWinPath (WinPhysicalPath n) 
    = "\\\\.\\PHYSICALDRIVE"++(show n)
showWinPath (WinVolumePath (Left c))     
    = "\\\\.\\"++[c]++"\\"
showWinPath (WinVolumePath (Right guid)) 
    = "\\\\?\\Volume{"++(showWinPathSeg guid)++"}\\"
showWinPath (WinTapePath n) 
    = "\\\\.\\TAPE"++(show n)
showWinPath (WinCommPath d) = show d
showWinPath (WinMailslotPath m segs) = 
   let path = foldl (\p s -> winPathSeparator : (showWinPathSeg s) ++ p) "" segs
   in concat ["\\\\",show m,"\\mailslot",path]
showWinNamedPipePath (WinNamedPipePath p) 
    = "\\\\.\\pipe\\"++(showWinPathSeg p)

instance Show WinPath       where show = showWinPath
instance Show WinCommDevice where show = showWinCommDevice
instance Show MailslotDest  where show = showMailslotDest