-- This file is part of Hoppy.
--
-- Copyright 2015-2021 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- 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 Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | Miscellaneous utilities that may be useful in Hoppy generators.
module Foreign.Hoppy.Generator.Util (
  -- * String utilities
  splitIntoWords,
  -- * File utilities
  withTempFile,
  withTempDirectory,
  ) where

import Control.Exception (IOException, catch, throwIO)
import Control.Monad (when)
import Data.Char (isDigit, isLetter, isLower, isUpper)
import System.Directory (
  doesDirectoryExist,
  doesFileExist,
  getTemporaryDirectory,
  removeFile,
  removeDirectoryRecursive,
  )
import System.IO (Handle, openTempFile)
import System.IO.Temp (createTempDirectory)

-- | Splits a C++ identifier string into multiple words, doing smart inspection
-- of the case convention of the string.  This supports @snake_case@ and
-- @CONSTANT_CASE@, and recognition of @camelCase@, including when acronyms are
-- uppercased (@\"HTMLElement\"@ gives @[\"HTML\", \"Element\"]@).  Numbers are
-- treated as their own words, and non-alphanumeric characters are treated as
-- word separators and dropped.
splitIntoWords :: String -> [String]
splitIntoWords :: String -> [String]
splitIntoWords String
cs = case String
cs of
  String
"" -> []

  -- The case of multiple upper-case letters, e.g. "HTML", or "HTMLElement".
  Char
c1:Char
c2:String
_ | Char -> Bool
isUpper Char
c1 Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
c2 ->
    let (String
upperWord, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper String
cs
        (String
upperWord', String
rest') = case String
rest of
          -- This handles the "HTMLElement" case, where we need to shift from
          -- "HTMLE"/"lement" to "HTML"/"Element".
          Char
c3:String
_ | Char -> Bool
isLower Char
c3 ->
            let (String
word, String
lastChar) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
upperWord Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
upperWord
            in (String
word, String
lastChar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest)
          -- But if the part after the upper case part doesn't start with a
          -- lower case letter, then there's no rearranging to do.
          String
_ -> (String
upperWord, String
rest)
    in String
upperWord' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitIntoWords String
rest'

  -- The case of letters, but not multiple upper case letters.  Here we want to
  -- take grab "foo" from "fooBar", "a" from "aWidget", and "Too" from "TooNie".
  Char
c1:String
cs' | Char -> Bool
isLetter Char
c1 ->
    let (String
wordTail, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isLower String
cs'
    in (Char
c1Char -> String -> String
forall a. a -> [a] -> [a]
:String
wordTail) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitIntoWords String
rest

  -- Numbers get treated as their own words.
  Char
c1:String
_ | Char -> Bool
isDigit Char
c1 ->
    let (String
word, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs
    in String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitIntoWords String
rest

  -- Non-alphanumeric characters may act as word barriers, but otherwise get
  -- dropped.
  Char
_:String
cs' -> String -> [String]
splitIntoWords String
cs'

-- | Creates a temporary file whose name is based on the given template string,
-- and runs the given function with the path to the file.  The file is deleted
-- when the function completes, if the boolean that the function returns (or, in
-- case of an exception, the boolean that was passed directly to 'withTempFile')
-- is true.
withTempFile :: String -> Bool -> (FilePath -> Handle -> IO (Bool, a)) -> IO a
withTempFile :: String -> Bool -> (String -> Handle -> IO (Bool, a)) -> IO a
withTempFile String
template Bool
deleteOnException String -> Handle -> IO (Bool, a)
f = do
  String
tempDir <- IO String
getTemporaryDirectory
  (String
path, Handle
handle) <- String -> String -> IO (String, Handle)
openTempFile String
tempDir String
template
  IO a -> (IOException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (do (Bool
delete, a
result) <- String -> Handle -> IO (Bool, a)
f String
path Handle
handle
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delete (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFileIfExists String
path
            a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result)
        (\(IOException
e :: IOException) -> do
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
deleteOnException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFileIfExists String
path
           IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO IOException
e)
  where removeFileIfExists :: String -> IO ()
removeFileIfExists String
path = do
          Bool
exists <- String -> IO Bool
doesFileExist String
path
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
path

-- | Creates a temporary directory whose name is based on the given template
-- string, and runs the given function with the directory's path.  The directory
-- is deleted when the function completes, if the boolean that the function
-- returns (or, in case of an exception, the boolean that was passed directly to
-- 'withTempDirectory') is true.
withTempDirectory :: String -> Bool -> (FilePath -> IO (Bool, a)) -> IO a
withTempDirectory :: String -> Bool -> (String -> IO (Bool, a)) -> IO a
withTempDirectory String
template Bool
deleteOnException String -> IO (Bool, a)
f = do
  String
outerDir <- IO String
getTemporaryDirectory
  String
dir <- String -> String -> IO String
createTempDirectory String
outerDir String
template
  IO a -> (IOException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (do (Bool
delete, a
result) <- String -> IO (Bool, a)
f String
dir
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delete (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeIfExists String
dir
            a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result)
        (\(IOException
e :: IOException) -> do
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
deleteOnException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeIfExists String
dir
           IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO IOException
e)
  where removeIfExists :: String -> IO ()
removeIfExists String
dir = do
          Bool
exists <- String -> IO Bool
doesDirectoryExist String
dir
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
dir