-- Copyright 2018 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

-- | This module tries to avoid confusing relative, absolute, and canonical
-- paths at the type level.  This is different from the hackage @paths@
-- package, because I have Relative to AppDir, and I distinguish Canonical.
--
-- I used to have a separate Absolute path, but the conversions get awkward.
module App.Path (
    AppDir(..), get_app_dir
    , Relative, relative, (</>)
    , to_absolute
    -- * Canonical
    , Canonical, make_canonical, canonical, to_path
    , drop_prefix
) where
import qualified Data.List as List
import qualified Data.String as String
import qualified GHC.Stack as Stack
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath

import qualified Util.Lists as Lists


-- | All paths should be relative to this one.
-- I may later change this to an env var, a flag, or just leave it hardcoded.
get_app_dir :: IO AppDir
get_app_dir :: IO AppDir
get_app_dir = FilePath -> AppDir
AppDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
Directory.getCurrentDirectory

newtype AppDir = AppDir FilePath
    deriving (AppDir -> AppDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppDir -> AppDir -> Bool
$c/= :: AppDir -> AppDir -> Bool
== :: AppDir -> AppDir -> Bool
$c== :: AppDir -> AppDir -> Bool
Eq, Int -> AppDir -> ShowS
[AppDir] -> ShowS
AppDir -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AppDir] -> ShowS
$cshowList :: [AppDir] -> ShowS
show :: AppDir -> FilePath
$cshow :: AppDir -> FilePath
showsPrec :: Int -> AppDir -> ShowS
$cshowsPrec :: Int -> AppDir -> ShowS
Show)

-- | Paths which are intended to be relative to the app dir get this type,
-- so it's harder to accidentally use them directly.
newtype Relative = Relative FilePath
    deriving (Relative -> Relative -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relative -> Relative -> Bool
$c/= :: Relative -> Relative -> Bool
== :: Relative -> Relative -> Bool
$c== :: Relative -> Relative -> Bool
Eq, Int -> Relative -> ShowS
[Relative] -> ShowS
Relative -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Relative] -> ShowS
$cshowList :: [Relative] -> ShowS
show :: Relative -> FilePath
$cshow :: Relative -> FilePath
showsPrec :: Int -> Relative -> ShowS
$cshowsPrec :: Int -> Relative -> ShowS
Show, FilePath -> Relative
forall a. (FilePath -> a) -> IsString a
fromString :: FilePath -> Relative
$cfromString :: FilePath -> Relative
String.IsString)

relative :: Stack.HasCallStack => FilePath -> Relative
relative :: HasCallStack => FilePath -> Relative
relative FilePath
path
    | FilePath
"/" forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` FilePath
path =
        forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"so-called relative path no so relative: " forall a. Semigroup a => a -> a -> a
<> FilePath
path
    | Bool
otherwise = FilePath -> Relative
Relative FilePath
path

(</>) :: Relative -> Relative -> Relative
Relative FilePath
a </> :: Relative -> Relative -> Relative
</> Relative FilePath
b = FilePath -> Relative
Relative (FilePath
a FilePath -> ShowS
FilePath.</> FilePath
b)

to_absolute :: AppDir -> Relative -> FilePath
to_absolute :: AppDir -> Relative -> FilePath
to_absolute (AppDir FilePath
app_dir) (Relative FilePath
path) = FilePath
app_dir FilePath -> ShowS
FilePath.</> FilePath
path

-- * Canonical

-- | This is a path that is absolute and has had all the symlinks squeezed out.
-- The only reason I have this is that I want to strip the global save dir
-- prefix to get a shorter save file name.  Save filenames come from the user
-- and likely involve symlinks.
newtype Canonical = Canonical FilePath
    deriving (Canonical -> Canonical -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Canonical -> Canonical -> Bool
$c/= :: Canonical -> Canonical -> Bool
== :: Canonical -> Canonical -> Bool
$c== :: Canonical -> Canonical -> Bool
Eq, Int -> Canonical -> ShowS
[Canonical] -> ShowS
Canonical -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Canonical] -> ShowS
$cshowList :: [Canonical] -> ShowS
show :: Canonical -> FilePath
$cshow :: Canonical -> FilePath
showsPrec :: Int -> Canonical -> ShowS
$cshowsPrec :: Int -> Canonical -> ShowS
Show)

-- | For tests.
make_canonical :: FilePath -> Canonical
make_canonical :: FilePath -> Canonical
make_canonical = FilePath -> Canonical
Canonical

canonical :: FilePath -> IO Canonical
canonical :: FilePath -> IO Canonical
canonical = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Canonical
Canonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
Directory.canonicalizePath

to_path :: Canonical -> FilePath
to_path :: Canonical -> FilePath
to_path (Canonical FilePath
path) = FilePath
path

drop_prefix :: Canonical -> Canonical -> FilePath
drop_prefix :: Canonical -> Canonical -> FilePath
drop_prefix (Canonical FilePath
prefix) (Canonical FilePath
path) =
    forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'/') forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> ([a], Bool)
Lists.dropPrefix FilePath
prefix FilePath
path