content: module Ho.Library(
      LibDesc(..),
      readDescFile,
      collectLibraries,
      libModMap,
      libHash,
      libMgHash,
      libProvides,
      libName,
      libBaseName,
      libHoLib,
      preprocess,
      listLibraries
      ) where
  
  import Control.Monad
  import Data.Char
  import Data.List
  import Data.Maybe
  import Data.Monoid
  import Data.Version
  import Data.Yaml.Syck
  import System.Directory
  import Text.Printf
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Lazy as LBS
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  import qualified System.FilePath as FP
  
  import Ho.Binary
  import Ho.ReadSource
  import Ho.Type
  import Name.Name(Module)
  import Options
  import PackedString(PackedString,packString,unpackPS)
  import Util.Gen
  import Util.YAML
  import qualified FlagDump as FD
  import qualified FlagOpts as FO
  import qualified Support.MD5 as MD5
  
  libModMap = hoModuleMap . libHoLib
  libHash  = hohHash . libHoHeader
  libMgHash mg lib = MD5.md5String $ show (libHash lib,mg)
  libProvides mg lib = [ m | (m,mg') <- Map.toList (libModMap lib), mg == mg']
  libName lib = let HoHeader { hohName = ~(Right (name,vers)) } = libHoHeader lib in unpackPS name ++ "-" ++ showVersion vers
  libVersion lib = let HoHeader { hohName = ~(Right (_name,vers)) } = libHoHeader lib in vers
  libBaseName lib = let HoHeader { hohName = ~(Right (name,_vers)) } = libHoHeader lib in name
  libModules l = let lib = libHoLib l in ([ m | (m,_) <- Map.toList (hoModuleMap lib)],Map.toList (hoReexports lib))
  
  libVersionCompare l1 l2 = compare (libVersion l1) (libVersion l2)
  
  --------------------------------
  -- finding and listing libraries
  --------------------------------
  
  instance ToNode Module where
      toNode m = toNode $ show m
  instance ToNode HoHash where
      toNode m = toNode $ show m
  instance ToNode PackedString where
      toNode m = toNode $ unpackPS m
  
  listLibraries :: IO ()
  listLibraries = do
      (_,byhashes) <- fetchAllLibraries
      let libs = Map.toList byhashes
      if not verbose then putStr $ showYAML (sort $ map (libName . snd) libs) else do
      let f (h,l) = (show h,[
              ("Name",toNode (libName l)),
              ("BaseName",toNode (libBaseName l)),
              ("Version",toNode (showVersion $ libVersion l)),
              ("FilePath",toNode (libFileName l)),
              ("LibDeps",toNode [ h | (_,h) <- hohLibDeps (libHoHeader l)]),
              ("Exported-Modules",toNode $ mod ++ fsts rmod)
              ]) where
            (mod,rmod) = libModules l
      putStr $ showYAML (map f libs)
  
  -- Collect all libraries and return those which are explicitly and implicitly imported.
  --
  -- The basic process is:
  --    - Find all libraries and create two indexes, a map of named libraries to
  --      the newest version of them, and a map of library hashes to the libraries
  --      themselves.
  --
  --    - For all the libraries listed on the command line, find the newest
  --      version of each of them, flag these as the explicitly imported libraries.
  --
  --    - recursively find the dependencies by the hash's listed in the library deps. if the names
  --      match a library already loaded, ensure the hash matches up. flag these libraries as 'implicit' unless
  --      already flaged 'explicit'
  --
  --    - perform sanity checks on final lists of implicit and explicit libraries.
  --
  -- Library Checks needed:
  --    - We have found versions of all libraries listed on the command line
  --    - We have all dependencies of all libraries and the hash matches the proper library name
  --    - no libraries directly export the same modules, (but re-exporting the same module is fine)
  --    - conflicting versions of any particular library are not required due to dependencies
  
  fetchAllLibraries :: IO (Map.Map PackedString [Library],Map.Map HoHash Library)
  fetchAllLibraries = ans where
      ans = do
          (bynames',byhashes') <- unzip `fmap` concatMapM f (optHlPath options)
          let bynames = Map.map (reverse . sortBy libVersionCompare) $ Map.unionsWith (++) bynames'
              byhashes = Map.unions byhashes'
          return (bynames,byhashes)
      f fp = do
          fs <- flip iocatch (\_ -> return [] ) $ getDirectoryContents fp
          forM fs $ \e -> case reverse e of
              ('l':'h':'.':r)  -> flip iocatch (\_ -> return mempty) $ do
                  lib <- readHlFile  (fp ++ "/" ++ e)
                  return (Map.singleton (libBaseName lib) [lib], Map.singleton (libHash lib) lib)
              _               -> return mempty
  
  splitOn' :: (a -> Bool) -> [a] -> [[a]]
  splitOn' f xs = split xs
    where split xs = case break f xs of
            (chunk,[])     -> [chunk]
            (chunk,_:rest) -> chunk : split rest
  
  splitVersion :: String -> (String,Data.Version.Version)
  splitVersion s = ans where
      ans = case reverse (splitOn' ('-' ==) s) of
          (vrs:bs@(_:_)) | Just vrs <- runReadP parseVersion vrs -> (intercalate "-" (reverse bs),vrs)
          _ -> (s,Data.Version.Version [] [])
  
  collectLibraries :: [String] -> IO ([Library],[Library])
  collectLibraries libs = ans where
      ans = do
          (bynames,byhashes) <- fetchAllLibraries
          let f (pn,vrs) = lname pn vrs `mplus` lhash pn vrs where
                  lname pn vrs = do
                      xs <- Map.lookup (packString pn) bynames
                      (x:_) <- return $ filter isGood xs
                      return x
                  isGood lib = versionBranch vrs `isPrefixOf` versionBranch (libVersion lib)
                  lhash pn vrs = do
                      [] <- return $ versionBranch vrs
                      Map.lookup pn byhashes'
              byhashes' = Map.fromList [ (show x,y) | (x,y) <- Map.toList byhashes]
          let es' = [ (x,f $ splitVersion x) | x <- libs ]
              es = [ l | (_,Just l) <- es' ]
              bad = [ n | (n,Nothing) <- es' ]
          unless (null bad) $ do
              putErrLn "Libraries not found:"
              forM_ bad $ \b -> putErrLn ("    " ++ b)
              exitFailure
  
          checkForModuleConficts es
          let f lmap _ [] = return lmap
              f lmap lset ((ei,l):ls)
                  | libHash l `Set.member` lset = f lmap lset ls
                  | otherwise = case Map.lookup (libBaseName l) lmap of
                      Nothing -> f (Map.insert (libBaseName l) (ei,l) lmap) (Set.insert (libHash l) lset) (ls ++ newdeps)
                      Just (ei',l') | libHash l == libHash l' -> f  (Map.insert (libBaseName l) (ei || ei',l) lmap) lset ls
                      Just (_,l')  -> putErrDie $ printf  "Conflicting versions of library '%s' are required. [%s]\n" (libName l) (show (libHash l,libHash l'))
                where newdeps = [ (False,fromMaybe (error $ printf "Dependency '%s' with hash '%s' needed by '%s' was not found" (unpackPS p) (show h) (libName l)) (Map.lookup h byhashes)) | let HoHeader { hohLibDeps = ldeps } = libHoHeader l , (p,h) <- ldeps ]
          finalmap <- f Map.empty Set.empty [ (True,l) | l <- es ]
          checkForModuleConficts [ l | (_,l) <- Map.elems finalmap ]
          when verbose $ forM_ (Map.toList finalmap) $ \ (n,(e,l)) ->
              printf "-- Base: %s Exported: %s Hash: %s Name: %s\n" (unpackPS n) (show e) (show $ libHash l) (libName l)
  
          return ([ l | (True,l) <- Map.elems finalmap ],[ l | (False,l) <- Map.elems finalmap ])
  
      checkForModuleConficts ms = do
          let mbad = Map.toList $ Map.filter (\c -> case c of [_] -> False; _ -> True)  $ Map.fromListWith (++) [ (m,[l]) | l <- ms, m <- fst $ libModules l]
          forM_ mbad $ \ (m,l) -> putErrLn $ printf "Module '%s' is exported by multiple libraries: %s" (show m) (show $ map libName l)
          unless (null mbad) $ putErrDie "There were conflicting modules!"
  
  parseLibraryDescription :: Monad m => String -> m [(String,String)]
  parseLibraryDescription fs =  g [] (lines (f [] fs)) where
      --f rs ('\n':s:xs) | isSpace s = f rs (dropWhile isSpace xs)
      f rs ('-':'-':xs) = f rs (dropWhile (/= '\n') xs)
      f rs ('{':'-':xs) = eatCom rs xs
      f rs (x:xs) = f (x:rs) xs
      f rs [] = reverse rs
      eatCom rs ('\n':xs) = eatCom ('\n':rs) xs
      eatCom rs ('-':'}':xs) = f rs xs
      eatCom rs (_:xs) = eatCom rs xs
      eatCom rs [] = f rs []
      g rs (s:ss) | all isSpace s = g rs ss
      g rs (s:s':ss) | all isSpace s' = g rs (s:ss)
      g rs (s:(h:cl):ss) | isSpace h = g rs ((s ++ h:cl):ss)
      g rs (r:ss) | (':':bd') <- bd = g ((map toLower $ condenseWhitespace nm,condenseWhitespace bd'):rs) ss
           | otherwise = fail $ "could not find ':' marker: " ++ show (rs,r:ss) where
              (nm,bd) = break (== ':') r
      g rs [] = return rs
  
  condenseWhitespace xs =  reverse $ dropWhile isSpace (reverse (dropWhile isSpace (cw xs))) where
      cw (x:y:zs) | isSpace x && isSpace y = cw (' ':zs)
      cw (x:xs) = x:cw xs
      cw [] = []
  
  procCabal :: [(String,String)] -> LibDesc
  procCabal xs = f xs mempty mempty where
      f [] dlm dsm = LibDesc (combineAliases dlm) dsm
      f ((map toLower -> x,y):rs) dlm dsm | x `Set.member` list_fields = f rs (Map.insert x (spit y) dlm) dsm
                                          | otherwise = f rs dlm (Map.insert x y dsm)
      spit = words . map (\c -> if c == ',' then ' ' else c)
  
  procYaml :: YamlNode -> LibDesc
  procYaml MkNode { n_elem = EMap ms } = f ms mempty mempty where
      f [] dlm dsm = LibDesc (combineAliases dlm) dsm
      f ((n_elem -> EStr (map toLower . unpackBuf -> x),y):rs) dlm dsm = if x `Set.member` list_fields then dlist y else dsing y where
          dlist (n_elem -> EStr y)  = f rs (Map.insert x [unpackBuf y] dlm) dsm
          dlist (n_elem -> ESeq ss) = f rs (Map.insert x [ unpackBuf y | (n_elem -> EStr y) <- ss ] dlm) dsm
          dlist _ = f rs dlm dsm
          dsing (n_elem -> EStr y) = f rs dlm (Map.insert x (unpackBuf y) dsm)
          dsing _ = f rs dlm dsm
      f (_:xs) dlm dsm = f xs dlm dsm
  procYaml _ = LibDesc mempty mempty
  
  list_fields = Set.fromList $ [
      "exposed-modules",
      "include-dirs",
      "extensions",
      "options",
      "c-sources",
      "include-sources",
      "build-depends"
      ] ++ map fst alias_fields
        ++ map snd alias_fields
  
  alias_fields = [
     ("other-modules","hidden-modules"),
     ("exported-modules","exposed-modules"),
     ("hs-source-dir","hs-source-dirs")
     ]
  
  combineAliases mp = f alias_fields mp where
      f [] mp = mp
      f ((x,y):rs) mp = case Map.lookup x mp of
          Nothing -> f rs mp
          Just ys -> f rs $ Map.delete x $ Map.insertWith (++) y ys mp
  
  data LibDesc = LibDesc (Map.Map String [String]) (Map.Map String String)
  
  readDescFile :: FilePath -> IO LibDesc
  readDescFile fp = do
      wdump FD.Progress $ putErrLn $ "Reading: " ++ show fp
      let doYaml opt = do
              lbs <- LBS.readFile fp
              dt <- preprocess opt fp lbs
              desc <- iocatch (parseYamlBytes $ BS.concat (LBS.toChunks dt))
                  (\e -> putErrDie $ "Error parsing desc file '" ++ fp ++ "'\n" ++ show e)
              when verbose2 $ do
                  yaml <- emitYaml desc
                  putStrLn yaml
              return $ procYaml desc
          doCabal = do
              fc <- readFile fp
              case parseLibraryDescription fc of
                  Left err -> fail $ "Error reading library description file: " ++ show fp ++ " " ++ err
                  Right ps -> return $ procCabal ps
      case FP.splitExtension fp of
          (_,".cabal") -> doCabal
          (_,".yaml") -> doYaml options
          (FP.takeExtension -> ".yaml",".m4") -> doYaml options { optFOptsSet = FO.M4 `Set.insert` optFOptsSet options }
          _ -> putErrDie $ "Do not recoginize description file type: " ++ fp
  