-- ------------------------------------------------------------
-- * options in source files
-- ------------------------------------------------------------

-- |Read the initial part of a source file, before any Haskell code,
-- and return the contents of any LANGUAGE, OPTIONS and INCLUDE pragmas.
getOptionsFromSource
    :: FilePath
    -> IO ([Extension],                 -- LANGUAGE pragma, if any
           [(CompilerFlavor,[String])], -- OPTIONS_FOO pragmas
           [String]                     -- INCLUDE pragmas
          )
getOptionsFromSource file =
    withHaskellFile file $
        (return $!)
      . foldr appendOptions ([],[],[]) . map getOptions
      . takeWhileJust . map getPragma
      . filter textLine . map (dropWhile isSpace) . lines
      . stripComments True

  where textLine [] = False
        textLine ('#':_) = False
        textLine _ = True

        getPragma :: String -> Maybe [String]
        getPragma line = case words line of
            ("{-#" : rest) | last rest == "#-}" -> Just (init rest)
            _ -> Nothing

        getOptions ("OPTIONS":opts) = ([], [(GHC, opts)], [])
        getOptions ("OPTIONS_GHC":opts) = ([], [(GHC, opts)], [])
        getOptions ("OPTIONS_NHC98":opts) = ([], [(NHC, opts)], [])
        getOptions ("OPTIONS_HUGS":opts) = ([], [(Hugs, opts)], [])
        getOptions ("LANGUAGE":ws) = (mapMaybe readExtension ws, [], [])
          where readExtension :: String -> Maybe Extension
                readExtension w = case reads w of
                    [(ext, "")] -> Just ext
                    [(ext, ",")] -> Just ext
                    _ -> Nothing
        getOptions ("INCLUDE":ws) = ([], [], ws)
        getOptions _ = ([], [], [])

        appendOptions (exts, opts, incs) (exts', opts', incs')
          = (exts++exts', opts++opts', incs++incs')

-- takeWhileJust f = map fromJust . takeWhile isJust
getOptionsFromSource
    :: FilePath
    -> IO ([Extension],                 -- LANGUAGE pragma, if any
           [(CompilerFlavor,[String])], -- OPTIONS_FOO pragmas
           [String]                     -- INCLUDE pragmas
          )
getOptionsFromSource file =
    withHaskellFile file $
        (return $!)
      . foldr appendOptions ([],[],[]) . map getOptions
      . takeWhileJust . map getPragma
      . filter textLine . map (dropWhile isSpace) . lines
      . stripComments True

  where textLine [] = False
        textLine ('#':_) = False
        textLine _ = True

        getPragma :: String -> Maybe [String]
        getPragma line = case words line of
            ("{-#" : rest) | last rest == "#-}" -> Just (init rest)
            _ -> Nothing

        getOptions ("OPTIONS":opts) = ([], [(GHC, opts)], [])
        getOptions ("OPTIONS_GHC":opts) = ([], [(GHC, opts)], [])
        getOptions ("OPTIONS_NHC98":opts) = ([], [(NHC, opts)], [])
        getOptions ("OPTIONS_HUGS":opts) = ([], [(Hugs, opts)], [])
        getOptions ("LANGUAGE":ws) = (mapMaybe readExtension ws, [], [])
          where readExtension :: String -> Maybe Extension
                readExtension w = case reads w of
                    [(ext, "")] -> Just ext
                    [(ext, ",")] -> Just ext
                    _ -> Nothing
        getOptions ("INCLUDE":ws) = ([], [], ws)
        getOptions _ = ([], [], [])

        appendOptions (exts, opts, incs) (exts', opts', incs')
          = (exts++exts', opts++opts', incs++incs')

-- takeWhileJust f = map fromJust . takeWhile isJust
getOptionsFromSource file =
    withHaskellFile file $
        (return $!)
      . foldr appendOptions ([],[],[]) . map getOptions
      . takeWhileJust . map getPragma
      . filter textLine . map (dropWhile isSpace) . lines
      . stripComments True

  where textLine [] = False
        textLine ('#':_) = False
        textLine _ = True

        getPragma :: String -> Maybe [String]
        getPragma line = case words line of
            ("{-#" : rest) | last rest == "#-}" -> Just (init rest)
            _ -> Nothing

        getOptions ("OPTIONS":opts) = ([], [(GHC, opts)], [])
        getOptions ("OPTIONS_GHC":opts) = ([], [(GHC, opts)], [])
        getOptions ("OPTIONS_NHC98":opts) = ([], [(NHC, opts)], [])
        getOptions ("OPTIONS_HUGS":opts) = ([], [(Hugs, opts)], [])
        getOptions ("LANGUAGE":ws) = (mapMaybe readExtension ws, [], [])
          where readExtension :: String -> Maybe Extension
                readExtension w = case reads w of
                    [(ext, "")] -> Just ext
                    [(ext, ",")] -> Just ext
                    _ -> Nothing
        getOptions ("INCLUDE":ws) = ([], [], ws)
        getOptions _ = ([], [], [])

        appendOptions (exts, opts, incs) (exts', opts', incs')
          = (exts++exts', opts++opts', incs++incs')

-- takeWhileJust f = map fromJust . takeWhile isJust