{-| Internal utility functions.

-}
module Shikensu.Internal.Utilities
    ( commonDirectory
    , compileParentPath
    , compilePathToRoot
    , replaceSingleDot
    , stripPrefix
    , takeDirName
    ) where

import Data.Maybe (fromMaybe)
import Flow
import System.FilePath

import qualified Data.List as List (map, stripPrefix)
import qualified Data.Tuple as Tuple (fst)
import qualified System.FilePath.Glob as Glob


{-| Get the common directory from a pattern.
-}
commonDirectory :: String -> FilePath
commonDirectory :: String -> String
commonDirectory =
    String -> Pattern
Glob.compile
    (String -> Pattern)
-> (Pattern -> (String, Pattern)) -> String -> (String, Pattern)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Pattern -> (String, Pattern)
Glob.commonDirectory
    (String -> (String, Pattern))
-> ((String, Pattern) -> String) -> String -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> (String, Pattern) -> String
forall a b. (a, b) -> a
Tuple.fst
    (String -> String) -> (String -> String) -> String -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> String -> String
normalise
    (String -> String) -> (String -> String) -> String -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> String -> String
dropTrailingPathSeparator
    (String -> String) -> (String -> String) -> String -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> String -> String
replaceSingleDot


{-| Path to parent, when there is one.

> Just "../" or Nothing

-}
compileParentPath :: FilePath -> Maybe FilePath
compileParentPath :: String -> Maybe String
compileParentPath String
dirname =
    case String
dirname of
        String
"" -> Maybe String
forall a. Maybe a
Nothing
        String
_  -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
addTrailingPathSeparator String
".."


{-| Path to root.

Example, if `dirname` is 'example/subdir',
then this will be `../../`.

If the `dirname` is empty,
then this will be empty as well.

-}
compilePathToRoot :: FilePath -> FilePath
compilePathToRoot :: String -> String
compilePathToRoot String
dirname =
    if String
dirname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then
        String
""
    else
        String
dirname
            String -> (String -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
|> String -> [String]
splitDirectories
            [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
|> (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
forall a b. a -> b -> a
const String
"..")
            [String] -> ([String] -> String) -> String
forall a b. a -> (a -> b) -> b
|> [String] -> String
joinPath
            String -> (String -> String) -> String
forall a b. a -> (a -> b) -> b
|> String -> String
addTrailingPathSeparator


{-| If the path is a single dot, return an empty string.
Otherwise return the path.
-}
replaceSingleDot :: String -> String
replaceSingleDot :: String -> String
replaceSingleDot String
path =
    if String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." then String
"" else String
path


{-| Strip prefix.
-}
stripPrefix :: String -> String -> String
stripPrefix :: String -> String -> String
stripPrefix String
prefix String
target =
    String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
target (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
prefix String
target)


{-| Take dirname and replace single dot.
-}
takeDirName :: FilePath -> FilePath
takeDirName :: String -> String
takeDirName =
    String -> String
takeDirectory (String -> String) -> (String -> String) -> String -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> String -> String
replaceSingleDot