module Porte.Ports where
import Control.Exception
import Control.Monad
import Data.ByteString.Search.KnuthMorrisPratt
import qualified Data.ByteString.Lazy.Char8     as B
import qualified Data.ByteString.Char8          as C 
import qualified Data.List                      as L
import qualified System.IO                      as I
import qualified System.Environment             as E

portsIndex = "/usr/ports/INDEX-8"
portsPrefix = "/usr/ports/"

type Name = B.ByteString
type DistributionName = B.ByteString 
type Path = B.ByteString
type Prefix = B.ByteString
type Comment = B.ByteString
type DescriptionPath = B.ByteString
type PortDescription = Maybe B.ByteString
type Maintainer = B.ByteString
type Categories = [B.ByteString]
type ExtractDepends = [B.ByteString]
type PatchDepends = [B.ByteString]
type FetchDepends = [B.ByteString]
type BuildDepends = [B.ByteString]
type RunDepends = [B.ByteString]
type Website = B.ByteString

data Port = Port {
              name :: Name,
              distributionName :: DistributionName,
              path :: Path,
              comment :: Comment,
              descriptionPath :: DescriptionPath,
              maintainer :: Maintainer,
              categories :: Categories,
              buildDepends :: BuildDepends,
              website :: Website,
              extractDepends :: ExtractDepends
            } deriving (Eq, Show, Read)

type PortField = Port -> B.ByteString
type PortQuery = [(PortField, String)]

toField :: String -> Maybe PortField
toField "name" = Just name
toField "package" = Just distributionName
toField "distributionName" = Just distributionName
toField "path" = Just path
toField "comment" = Just comment
toField "category" = Just category
toField "maintainer" = Just maintainer
toField "website" = Just website
toField _ = Nothing

search :: PortQuery -> [Port] -> [Port]
search (x:xs) p =
  search xs $ filter f p
  where
  f p = case (matchSL (C.pack $ snd x) (fst x p)) of
          [] -> False
          _  -> True 
search _ p = p

find :: PortQuery -> [Port] -> [Port]
find (x:xs) p = find xs $ filter f p
                where
                f p = (B.pack $ snd x) == (fst x p)
find _ p = p

description :: Port -> IO (Maybe B.ByteString)
description p =
  do
  o <- try $ (B.readFile . B.unpack . descriptionPath) p
  case (o) of
    Left h  -> return Nothing 
    Right h -> return $ Just $ B.filter (/= '\n') h

glue :: (Port -> [B.ByteString]) -> Port -> B.ByteString
glue f p = B.concat $ L.intersperse (B.pack " ") (f p) 
category = glue categories 
buildDepend = glue buildDepends
extractDepend = glue extractDepends

parseEntry :: B.ByteString -> Port
parseEntry =
  parseEntry' . B.split '|' 
  where
  parseEntry' 
     (name           :
      path           :
      prefix         : 
      comment        :
      pkgDescr       :
      maintainer     :
      categories     :
      buildDepends   :
      runDepends     :
      website        :
      extractDepends : _) =
        Port (B.tail . B.dropWhile (/= '/') $ path')
             (name)
             (path')
             (comment)
             (pkgDescr)
             (maintainer)
             (B.words categories)
             (B.words buildDepends)
             (website)
             (B.words extractDepends)
             where
             path' = B.drop (B.length $ B.pack portsPrefix) $ path

parseIndex :: B.ByteString -> [Port]
parseIndex = map parseEntry . B.lines

index :: (Maybe String) -> IO [Port]
index (Just []) = index (Just portsIndex)
index Nothing = do
 o <- try $ E.getEnv "INDEX"
 case o of
   Right h -> index $ Just h
   _       -> index $ Just portsIndex
index (Just path) = do
  o <- try $ B.readFile path
  case o of
    Left h -> error $ "INDEX file (" ++ path ++ ") could not be opened"
    Right h -> return $ parseIndex h 

putPorts :: [PortField] -> [Port] -> IO ()
putPorts f = hPutPorts I.stdout f

hPutPorts :: I.Handle -> [PortField] -> [Port] -> IO ()
hPutPorts h f p = forM_ p (hPutPort h f)

putPort :: [PortField] -> Port -> IO ()
putPort f = hPutPort I.stdout f

hPutPort :: I.Handle -> [PortField] -> Port -> IO ()
hPutPort h [f] p = B.hPut h (f p) >> I.hPutChar h '\n' 
hPutPort h (f:fs) p = B.hPut h (f p) >> I.hPutStr h ", " >> hPutPort h fs p  
hPutPort h _ p = I.hPutChar h '\n'