content: module Support.IniParse(parseIniFiles) where
  
  import Control.Monad.State
  import Data.Char
  import Data.List
  import GenUtil
  import qualified Data.Foldable as Seq
  import qualified Data.Map as Map
  import qualified Data.Sequence as Seq
  
  -- quick and dirty parser.
  
  type St = (Int,FilePath,String)
  
  newtype P a = P (State St a)
      deriving(Monad,MonadState St)
  
  third (_,_,x) = x
  
  look :: P String
  look = gets third
  
  discard :: Int -> P ()
  discard n = do
      (fl,fp,s) <- get
      let (x,y) = splitAt n s
      put (fl + length (filter (== '\n') x),fp, y)
  
  abort :: String -> P a
  abort msg = do
      (l,fp,_)  <- get
      fail $ fp ++ ":" ++ show l ++ ": " ++ msg
  
  dropSpace = do
      x <- look
      case x of
          ';':_ -> pdropWhile ('\n' /=) >> dropSpace
          c:_ | isSpace c -> pdropWhile isSpace >> dropSpace
          _ -> return ()
  
  pdropWhile f  = do
      x <- look
      case x of
          c:_ | f c -> discard 1 >> pdropWhile f
          _ -> return ()
  
  ptakeWhile f  = do
      x <- look
      let ts = takeWhile f x
      discard (length ts)
      return ts
  
  pThings ch rs zs  = ans where
      ans = look >>= \x -> case x of
          '[':_ -> do
              hv <- pHeader
              dropSpace
              pThings hv Seq.empty (zs Seq.|> (ch,rs))
          _:_ -> do
              v <- pValue
              dropSpace
              pThings ch (rs Seq.|> v) zs
          [] -> return (zs Seq.|> (ch,rs))
  
  trim = rbdropWhile isSpace
  
  expect w = do
      cs <- look
      if w `isPrefixOf` cs then discard (length w) else abort ("expected " ++ show w)
  
  pValue = do
      n <- ptakeWhile (`notElem` ['\n','='])
      expect "="
      rs <- ptakeWhile (/= '\n')
      return (trim n, trim rs)
  
  pHeader = do
      expect "["
      n <- ptakeWhile (`notElem` "]\n")
      expect "]"
      return (trim n)
  
  -- We use laziness cleverly to avoid repeating work
  processIni :: Seq.Seq (String,Seq.Seq (String,String)) -> Map.Map String (Seq.Seq (String,String))
  processIni iniRaw = iniMap' where
      iniMap,iniMap' :: Map.Map String (Seq.Seq (String,String))
      iniMap = Map.fromListWith (flip (Seq.><)) (Seq.toList iniRaw)
      iniMap' = Map.map expandChains iniMap
      expandChains x = join (fmap ecp x)
      ecp :: (String,String) -> Seq.Seq (String,String)
      ecp ("merge",v) = Map.findWithDefault Seq.empty v iniMap'
      ecp x = Seq.singleton x
  --    ans = Map.map (\c -> Seq.foldl res Map.empty c) iniMap'
  --    res mp (k,v) | Just r <- getPrefix "+" (reverse k) = Map.insertWith f (reverse $ dropWhile isSpace r) v mp where
  --        f y x = x ++ " " ++ y
  --    res mp (k,v) = Map.insert k v mp
  
  parseIniFile :: FilePath -> IO (Seq.Seq (String,Seq.Seq (String,String)))
  parseIniFile fp = readFile fp >>= parseIniRaw fp
  
  parseIniRaw :: String -> String -> IO (Seq.Seq (String,Seq.Seq (String,String)))
  parseIniRaw fp c = do
      let P act = dropSpace >> pThings "default" Seq.empty Seq.empty
      return $ evalState act (0,fp,c)
  
  parseIniFiles
      :: Bool          -- ^ whether verbose is enabled
      -> String        -- ^ raw ini contents to parse first
      -> [FilePath]    -- ^ the files (in order) we attempt to parse
      -> [String]      -- ^ the m-flags
      -> IO (Map.Map String String)
  parseIniFiles verbose raw fs ss = do
      let rf fn = iocatch (do c <- parseIniFile fn; pverb ("reading " ++ fn); return c) (\_ -> return Seq.empty)
          pverb s = if verbose then putErrLn s else return ()
      rawp <- parseIniRaw "(builtin targets.ini)" raw
      fsc <- mapM rf fs
      let pini = processIni (foldr (Seq.><) Seq.empty (rawp:fsc))
          f (x:xs) cm = case span (/= '=') x of
              (be,'=':re) -> f xs (res cm (be,re)) -- f xs (Map.insert be re cm)
              ~(be,[]) -> f xs (Seq.foldl res cm (Map.findWithDefault Seq.empty be pini))
          f [] cm = cm
  --    ans = Map.map (\c -> Seq.foldl res Map.empty c) iniMap'
          res mp (k,v) | Just r <- getPrefix "+" (reverse k) = Map.insertWith f (reverse $ dropWhile isSpace r) v mp where
              f y x = x ++ " " ++ y
          res mp (k,v) = Map.insert k v mp
      return (f ss Map.empty)
  
  --main = do
  --    as <- getArgs
  --    is <- mapM parseIniFile as
  --    let pi = processIni (foldr (Seq.><) Seq.empty is)
  --
  --    print "proc"
  --    let f (h,rs) = do
  --            putStrLn h
  --            mapM_ (\x -> putStr "    " >>  print x) (Map.toList rs)
  --    mapM_ f (Map.toList pi)
  