module System.Path.Internal.Component where

import qualified System.Path.Internal.Separator as Sep
import System.Path.Internal.System (System, canonicalize)

import Control.DeepSeq (NFData(rnf))
import Control.Applicative ((<$>))

import qualified Data.List.HT as ListHT
import Data.Tagged (Tagged(Tagged))
import Data.List (isPrefixOf)
import Data.Maybe.HT (toMaybe)
import Data.Tuple.HT (mapFst)
import Data.Ord.HT (comparing)
import Data.Eq.HT (equating)

import Prelude hiding (map)


newtype Component os = Component String

empty :: Component os
empty :: forall os. Component os
empty = String -> Component os
forall os. String -> Component os
Component String
""

instance NFData (Component os) where
    rnf :: Component os -> ()
rnf (Component String
pc) = String -> ()
forall a. NFData a => a -> ()
rnf String
pc

instance (System os) => Eq (Component os) where
    == :: Component os -> Component os -> Bool
(==)  =  (Component os -> String) -> Component os -> Component os -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating (Tagged os (String -> String) -> Component os -> String
forall os. Tagged os (String -> String) -> Component os -> String
applyComp Tagged os (String -> String)
forall os. System os => Tagged os (String -> String)
canonicalize)

instance (System os) => Ord (Component os) where
    compare :: Component os -> Component os -> Ordering
compare  =  (Component os -> String)
-> Component os -> Component os -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing (Tagged os (String -> String) -> Component os -> String
forall os. Tagged os (String -> String) -> Component os -> String
applyComp Tagged os (String -> String)
forall os. System os => Tagged os (String -> String)
canonicalize)

applyComp :: Tagged os (String -> String) -> Component os -> String
applyComp :: forall os. Tagged os (String -> String) -> Component os -> String
applyComp (Tagged String -> String
canon) (Component String
pc) = String -> String
canon String
pc

retag :: GenComponent -> Component os
retag :: forall os. GenComponent -> Component os
retag (Component String
pc) = String -> Component os
forall os. String -> Component os
Component String
pc

untag :: Component os -> GenComponent
untag :: forall os. Component os -> GenComponent
untag (Component String
pc) = String -> GenComponent
forall os. String -> Component os
Component String
pc


map :: (String -> String) -> Component os -> Component os
map :: forall os. (String -> String) -> Component os -> Component os
map String -> String
f (Component String
s) = String -> Component os
forall os. String -> Component os
Component (String -> Component os) -> String -> Component os
forall a b. (a -> b) -> a -> b
$ String -> String
f String
s

mapF ::
    (Functor f) =>
    (String -> f String) -> Component os -> f (Component os)
mapF :: forall (f :: * -> *) os.
Functor f =>
(String -> f String) -> Component os -> f (Component os)
mapF String -> f String
f (Component String
s) = String -> Component os
forall os. String -> Component os
Component (String -> Component os) -> f String -> f (Component os)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
s



addExtension :: Component os -> String -> Component os
addExtension :: forall os. Component os -> String -> Component os
addExtension Component os
p String
"" = Component os
p
addExtension (Component String
pc) String
ext =
    String -> Component os
forall os. String -> Component os
Component (String -> Component os) -> String -> Component os
forall a b. (a -> b) -> a -> b
$ String
pc String -> String -> String
forall a. [a] -> [a] -> [a]
++
        if [Char
Sep.extension] String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ext
          then String
ext
          else Char
Sep.extension Char -> String -> String
forall a. a -> [a] -> [a]
: String
ext

splitExtension :: Component os -> (Component os, String)
splitExtension :: forall os. Component os -> (Component os, String)
splitExtension (Component String
s) =
    (String -> Component os)
-> (String, String) -> (Component os, String)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst String -> Component os
forall os. String -> Component os
Component ((String, String) -> (Component os, String))
-> (String, String) -> (Component os, String)
forall a b. (a -> b) -> a -> b
$
    (String, String)
-> (([String], String) -> (String, String))
-> Maybe ([String], String)
-> (String, String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
s, String
"") (([String] -> String) -> ([String], String) -> (String, String)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (Maybe ([String], String) -> (String, String))
-> Maybe ([String], String) -> (String, String)
forall a b. (a -> b) -> a -> b
$
    ((\p :: ([String], String)
p@([String]
pcs,String
_) -> Bool -> ([String], String) -> Maybe ([String], String)
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
pcs)) ([String], String)
p) (([String], String) -> Maybe ([String], String))
-> Maybe ([String], String) -> Maybe ([String], String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe ([String], String) -> Maybe ([String], String))
-> Maybe ([String], String) -> Maybe ([String], String)
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe ([String], String)
forall a. [a] -> Maybe ([a], a)
ListHT.viewR ([String] -> Maybe ([String], String))
-> [String] -> Maybe ([String], String)
forall a b. (a -> b) -> a -> b
$
    (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
ListHT.segmentBefore Char -> Bool
Sep.isExtension String
s

_splitExtension :: Component os -> (Component os, String)
_splitExtension :: forall os. Component os -> (Component os, String)
_splitExtension (Component String
s) =
    (String -> Component os)
-> (String, String) -> (Component os, String)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst String -> Component os
forall os. String -> Component os
Component ((String, String) -> (Component os, String))
-> (String, String) -> (Component os, String)
forall a b. (a -> b) -> a -> b
$
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Sep.isExtension (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
s of
        (String
_, String
"") -> (String
s, String
"")
        (String
rext, Char
dot:String
rstem) -> (String -> String
forall a. [a] -> [a]
reverse String
rstem, Char
dot Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
forall a. [a] -> [a]
reverse String
rext)

splitExtensions :: Component os -> (Component os, String)
splitExtensions :: forall os. Component os -> (Component os, String)
splitExtensions (Component String
s) =
    (String -> Component os)
-> (String, String) -> (Component os, String)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst String -> Component os
forall os. String -> Component os
Component ((String, String) -> (Component os, String))
-> (String, String) -> (Component os, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Sep.isExtension String
s



data Generic = Generic

{- |
We cannot have a Component without phantom types plus a Tagged wrapper,
because we need specialised Eq and Ord instances.
-}
type GenComponent = Component Generic