Util.hs

{-|
Module      : Pansite.Config.Types
Description : Helper functions for Pansite application
Copyright   : (C) Richard Cook, 2017
Licence     : MIT
Maintainer  : rcook@rcook.org
Stability   : experimental
Portability : portable
-}

module PansiteApp.Util
    ( readFileUtf8
    , readFileWithEncoding
    , skipDirectory
    , stems
    , writeFileUtf8
    , writeFileWithEncoding
    ) where

import           System.FilePath
import           System.IO


-- | Compute common prefix of two lists
--
-- Examples:
--
-- >>> commonPrefix "abcdefghi" "abcdefghi"
-- "abcdefghi"
-- >>> commonPrefix "abcdefghi" "abcfoo"
-- "abc"
-- >>> commonPrefix "abc" "xyz"
-- ""
commonPrefix :: (Eq a) => [a] -> [a] -> [a]
commonPrefix _ [] = []
commonPrefix [] _ = []
commonPrefix (x : xs) (y : ys)
    | x == y = x : commonPrefix xs ys
    | otherwise = []

-- | Compute common suffix of two lists
--
-- Examples:
--
-- >>> commonSuffix "abcdefghi" "abcdefghi"
-- "abcdefghi"
-- >>> commonSuffix "abcdefghi" "fooghi"
-- "ghi"
-- >>> commonSuffix "abc" "xyz"
-- ""
commonSuffix :: (Eq a) => [a] -> [a] -> [a]
commonSuffix xs ys = reverse (commonPrefix (reverse xs) (reverse ys))

-- | Slice of list
--
-- Examples:
--
-- >>> slice 4 10 "helloworldgoodbye"
-- "oworld"
slice :: Int -> Int -> [a] -> [a]
slice p0 p1 xs = take (p1 - p0) (drop p0 xs)

-- | Stems of lists
--
-- Examples:
--
-- >>> stems "abcmiddledef" "abcfoodef"
-- ("middle","foo")
-- >>> stems "abc" "xyz"
-- ("abc","xyz")
stems :: (Eq a) => [a] -> [a] -> ([a], [a])
stems xs ys =
    let prefix = commonPrefix xs ys
        prefixCount = length prefix
        suffix = commonSuffix xs ys
        suffixCount = length suffix
        xsCount = length xs
        ysCount = length ys
    in (slice prefixCount (xsCount - suffixCount) xs, slice prefixCount (ysCount - suffixCount) ys)

readFileWithEncoding :: TextEncoding -> FilePath -> IO String
readFileWithEncoding encoding path = do
    h <- openFile path ReadMode
    hSetEncoding h encoding
    hGetContents h

readFileUtf8 :: FilePath -> IO String
readFileUtf8 = readFileWithEncoding utf8

writeFileWithEncoding :: TextEncoding -> FilePath -> String -> IO ()
writeFileWithEncoding encoding path content =
    withFile path WriteMode $ \h -> do
        hSetEncoding h encoding
        hPutStr h content

writeFileUtf8 :: FilePath -> String -> IO ()
writeFileUtf8 = writeFileWithEncoding utf8

skipDirectory :: FilePath -> FilePath
skipDirectory p = let d = takeDirectory p in drop (length d + 1) p