{-
  Copyright (C) 2010  Xyne

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  (version 2) as published by the Free Software Foundation.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
-}


{-
  This program parses the output of "pacman -Qi" to build a directed graph of
  local package dependencies. It then creates a subgraph starting from the
  packages specified on the command line and returns a topologically sorted
  list of all packages that depends on the specified packages, directly or
  indirectly.
-}

import Data.Graph
import Data.Maybe
import Data.Set (fromList, toList)
import System
import System.IO
import System.Process



-- | Generic node type, in case we need to change this later.
newtype PkgNode = PkgNode ()

-- | Type synonym, for clarity.
type Pkgname = String


-- | The Pacman binary path and arguments.
pacmanCmd :: CmdSpec
pacmanCmd = RawCommand "/usr/bin/pacman" ["-Qi"]



-- | The 'CreateProcess' type for invoking Pacman. This ensures that the output
--   is in English so it can be parsed.
pacmanProc :: CreateProcess
pacmanProc = CreateProcess
  {
    cmdspec = pacmanCmd,
    cwd = Nothing,
    env = Just [("LC_ALL", "C")],
    std_in = Inherit,
    std_out = CreatePipe,
    std_err = Inherit,
    close_fds = True
  }



-- | Get a graph of the package dependencies along with lookup functions.
--   See 'Data.Graph.graphFromEdges' for details.
pkgGraph :: IO (Graph, Vertex -> (PkgNode, Pkgname, [Pkgname]), Pkgname -> Maybe Vertex)
pkgGraph =
  createProcess pacmanProc >>= \ (_, Just h, _, _) ->
  parseDeps h [] Nothing Nothing >>= \ nodes ->
  return (graphFromEdges nodes)



-- | Parse Pacman's output and return a list of nodes for building the
--   depencency graph.
parseDeps
  :: Handle
  -- ^ The pacman output handle.
  -> [(PkgNode, Pkgname, [Pkgname])]
  --  ^ The list of "(node, key, [key])" for building the dependency tree.
  --    See "Data.Graph" for details.
  -> Maybe String
  -- ^ The current package name.
  -> Maybe [String]
  -- ^ The current dependencies. The list is wrapped in the Maybe monad because
  --   we need to distinguish between cases in which there are no deps and cases
  --   in which we have not yet parsed the field.
  -> IO [(PkgNode, Pkgname, [Pkgname])]
parseDeps h nodes mPkgname mDeps =
  let
    addNode pkgname deps =
      let
        nodes' = (PkgNode (), pkgname, deps) : nodes
      in
        parseDeps h nodes' Nothing Nothing
  in
    collectField h >>= \ mField ->
    case mField of
      -- EOF has been reached
      Nothing ->
        return nodes

      {-
        The "Name" field always comes first, but the extra checks ensure that
        the script does not depend on it.
      -}

      Just ("Name", pkgname) ->
        case mDeps of
          Nothing -> parseDeps h nodes (Just pkgname) mDeps
          Just deps -> addNode pkgname deps

      --Just ("Depends On", depsStr) ->
      Just ("Required By", depsStr) ->
        let
          unversion = takeWhile (flip notElem "<=>")
          deps =
--             map unversion $
            filter ("None" /=) $
            words depsStr
        in
          case mPkgname of
            Nothing -> parseDeps h nodes mPkgname (Just deps)
            Just pkgname -> addNode pkgname deps

      -- Ignore other fields and move on.
      _ ->
        parseDeps h nodes mPkgname mDeps




-- | Parse a line of Pacman info.
parseLine :: String -> (String, String)
parseLine str =
  let
    a =
      case str of
        ' ':_ -> ""
        _ ->
          reverse $
          dropWhile (' ' ==) $
          reverse $
          takeWhile (':' /=) str

    b =
      takeWhile ('\n' /=) $
      dropWhile (' ' ==) $
      drop 1 $
      dropWhile (':' /=) str
  in
    (a, b)



-- | Collect the name and value of a field, including multi-line values.
collectField :: Handle -> IO (Maybe (String, String))
collectField h =
  let
    collect h =
      hIsEOF h >>= \ isEOF ->
      if isEOF
        then return ""
        else
          -- Check if the next line is a continuation of the current field by
          -- checking if it beging with a space.
          hLookAhead h >>= \ c ->
          if c == ' '
            then
              hGetLine h >>= \ line ->
              collect h >>= \ rest ->
              case rest of
                "" -> return line
                _ -> return (dropWhile (' ' ==) line ++ ' ' : rest)

            else
              return ""

  in
    hIsEOF h >>= \ isEOF ->
    if isEOF
      then return Nothing
      else
        hGetLine h >>= \ line ->
        collect h >>= \ rest ->
        let
          x@(name, start) = parseLine line
        in
          case rest of
            "" -> return (Just x)
            _  -> return $ Just (name, start ++ (' ':rest))




-- | Look up the pkgname for a given vertex.
vertexToPkgname :: (Vertex -> (PkgNode, Pkgname, [Pkgname])) -> Vertex -> Pkgname
vertexToPkgname f v =
  let
    (_, pkgname, _) = f v
  in
    pkgname


-- | Return a list of pkgnames ordered so that packages that depend on other
--   packages come after those packages.
buildQueue
  :: Graph
  -- ^ The dependency graph.
  -> (Vertex -> (PkgNode, Pkgname, [Pkgname]))
  -- ^ A function to convert vertices to pkgnames.
  -> (Pkgname -> Maybe Vertex)
  -- ^ A function to match a vertex to a pkgname.
  -> [String]
  -- ^ The pkgnames to look up.
  -> [Pkgname]
  -- ^ The drawing.
buildQueue g f e pkgnames =
  let
    vs = map fromJust $ filter isJust $ map e pkgnames
    {-
      Convert this to a set and back to ensure the uniqueness of each node.
    -}
    subnodes = toList $ fromList $concat $ map (reachable g) vs
    (g', f', e') = graphFromEdges $ map f subnodes
    f'' = vertexToPkgname f'
    vs' = topSort g'
  in
    fmap f'' vs'











main :: IO ()
main =
  getArgs >>= \ pkgnames ->
  pkgGraph >>= \ (g, f, e) ->
  putStr (unlines $ buildQueue g f e pkgnames)