content: -- Copyright 2017 Evan Laforge
  -- This program is distributed under the terms of the GNU General Public
  -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt
  
  -- | A library to collect definitions from haskell source and collect them
  -- into an output source file.
  module Util.ExtractHs where
  import qualified Data.Char as Char
  import qualified Data.Map as Map
  import qualified Data.Text as Text
  import qualified Data.Text.IO as Text.IO
  
  import qualified System.Directory as Directory
  import qualified System.Environment
  import qualified System.Exit
  import qualified System.FilePath as FilePath
  import qualified System.IO as IO
  
  import           Global
  
  
  type Error = Text
  type Warning = Text
  
  -- | Extract from haskell source files, and generate output based on it.
  process :: [String] -> (Text -> a)
      -> (FilePath -> Map FilePath a -> Either Error ([Warning], Text))
      -> IO ()
  process args extract generate = do
      progName <- System.Environment.getProgName
      (outFname, inFnames) <- case args of
          outFname : inFnames -> return (outFname, inFnames)
          _ -> die $ "usage: " <> txt progName
              <> " output.hs input1.hs input2.hs ..."
      extracted <- extractFiles extract inFnames
      case generate outFname extracted of
          Left err -> die err
          Right (warnings, output) -> do
              mapM_ (Text.IO.hPutStrLn IO.stderr) warnings
              Directory.createDirectoryIfMissing True $
                  FilePath.takeDirectory outFname
              Text.IO.writeFile outFname $ header progName <> output
  
  header :: String -> Text
  header program =
      "-- Copyright 2017 Evan Laforge\n\
      \-- This program is distributed under the terms of the GNU General Public\n\
      \-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt\n\
      \\n\
      \-- automatically generated by " <> txt program <> "\n"
  
  extractFiles :: (Text -> a) -> [FilePath] -> IO (Map FilePath a)
  extractFiles extract =
      fmap Map.fromList . mapM (\fn -> (fn,) . extract <$> Text.IO.readFile fn)
  
  -- * extract
  
  -- | This is just barely enough of a parser to work for my purposes.
  typeDeclarations :: Text -> [(Int, (Text, Text))]
  typeDeclarations = concatMap parse . zip [1..] . Text.lines
      where
      parse (lineno, line)
          | line == "" || not (Char.isLower (Text.head line)) = []
          | otherwise = case break (=="::") (Text.words line) of
              (pre, "::" : typ) ->
                  [(lineno, (strip sym, Text.unwords typ)) | sym <- pre]
              _ -> []
      strip t = fromMaybe t $ Text.stripSuffix "," t
  
  -- | This will be fooled by a {- or -} inside a string.  I don't strip --
  -- comments because the extract functions look for left justified text.
  stripComments :: Text -> Text
  stripComments = mconcat . go 0
      where
      go nesting text
          | Text.null post = [text]
          | "{-" `Text.isPrefixOf` post =
              (if nesting > 0 then strip pre else pre)
                  : go (nesting+1) (Text.drop 2 post)
          | otherwise =
              (if nesting == 0 then pre <> Text.take 2 post else strip pre)
                  : go (max 0 (nesting-1)) (Text.drop 2 post)
          where
          (pre, post) = breakOnFirst "{-" "-}" text
          strip = Text.filter (=='\n')
  
  -- | Like 'Text.breakOn', but break either of two things.
  breakOnFirst :: Text -> Text -> Text -> (Text, Text)
  breakOnFirst a b text
      | Text.length aPre <= Text.length bPre = (aPre, aPost)
      | otherwise = (bPre, bPost)
      where
      (aPre, aPost) = Text.breakOn a text
      (bPre, bPost) = Text.breakOn b text
  
  -- * generate
  
  moduleDeclaration :: FilePath -> Text
  moduleDeclaration fname = "module " <> pathToModule fname <> " where"
  
  makeImport :: FilePath -> Text
  makeImport fname = "import qualified " <> pathToModule fname
  
  pathToModule :: FilePath -> Text
  pathToModule =
      Text.map dot . Text.pack . FilePath.dropExtension . FilePath.normalise
      where dot c = if c == '/' then '.' else c
  
  -- * util
  
  die :: Text -> IO a
  die msg = do
      Text.IO.hPutStrLn IO.stderr msg
      System.Exit.exitFailure
  