{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module HaskellWorks.CabalCache.Location
( IsPath(..)
, Location(..)
, toLocation
)
where
import Antiope.Core (ToText (..), fromText)
import Antiope.S3 (ObjectKey (..), S3Uri (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified Data.Text as T
import qualified System.FilePath as FP
class IsPath a s | a -> s where
(</>) :: a -> s -> a
(<.>) :: a -> s -> a
infixr 5 </>
infixr 7 <.>
data Location
= S3 S3Uri
| Local FilePath
| HttpUri Text
deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Generic)
instance ToText Location where
toText :: Location -> Text
toText (S3 S3Uri
uri) = S3Uri -> Text
forall a. ToText a => a -> Text
toText S3Uri
uri
toText (Local String
p) = String -> Text
T.pack String
p
toText (HttpUri Text
uri) = Text
uri
instance IsPath Location Text where
(S3 S3Uri
b) </> :: Location -> Text -> Location
</> Text
p = S3Uri -> Location
S3 (S3Uri
b S3Uri -> Text -> S3Uri
forall a s. IsPath a s => a -> s -> a
</> Text
p)
(Local String
b) </> Text
p = String -> Location
Local (String
b String -> ShowS
forall a s. IsPath a s => a -> s -> a
</> Text -> String
T.unpack Text
p)
(HttpUri Text
b) </> Text
p = Text -> Location
HttpUri (Text
b Text -> Text -> Text
forall a s. IsPath a s => a -> s -> a
</> Text
p)
(S3 S3Uri
b) <.> :: Location -> Text -> Location
<.> Text
e = S3Uri -> Location
S3 (S3Uri
b S3Uri -> Text -> S3Uri
forall a s. IsPath a s => a -> s -> a
<.> Text
e)
(Local String
b) <.> Text
e = String -> Location
Local (String
b String -> ShowS
forall a s. IsPath a s => a -> s -> a
<.> Text -> String
T.unpack Text
e)
(HttpUri Text
b) <.> Text
e = Text -> Location
HttpUri (Text
b Text -> Text -> Text
forall a s. IsPath a s => a -> s -> a
<.> Text
e)
instance IsPath Text Text where
Text
b </> :: Text -> Text -> Text
</> Text
p = String -> Text
T.pack (Text -> String
T.unpack Text
b String -> ShowS
FP.</> Text -> String
T.unpack Text
p)
Text
b <.> :: Text -> Text -> Text
<.> Text
e = String -> Text
T.pack (Text -> String
T.unpack Text
b String -> ShowS
FP.<.> Text -> String
T.unpack Text
e)
instance (a ~ Char) => IsPath [a] [a] where
[a]
b </> :: [a] -> [a] -> [a]
</> [a]
p = [a]
String
b String -> ShowS
FP.</> [a]
String
p
[a]
b <.> :: [a] -> [a] -> [a]
<.> [a]
e = [a]
String
b String -> ShowS
FP.<.> [a]
String
e
instance IsPath S3Uri Text where
S3Uri BucketName
b (ObjectKey Text
k) </> :: S3Uri -> Text -> S3Uri
</> Text
p =
BucketName -> ObjectKey -> S3Uri
S3Uri BucketName
b (Text -> ObjectKey
ObjectKey (Text -> Text -> Text
stripEnd Text
"/" Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
stripStart Text
"/" Text
p))
S3Uri BucketName
b (ObjectKey Text
k) <.> :: S3Uri -> Text -> S3Uri
<.> Text
e =
BucketName -> ObjectKey -> S3Uri
S3Uri BucketName
b (Text -> ObjectKey
ObjectKey (Text -> Text -> Text
stripEnd Text
"." Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
stripStart Text
"." Text
e))
toLocation :: Text -> Maybe Location
toLocation :: Text -> Maybe Location
toLocation Text
txt = if
| Text -> Text -> Bool
T.isPrefixOf Text
"s3://" Text
txt' -> (String -> Maybe Location)
-> (S3Uri -> Maybe Location)
-> Either String S3Uri
-> Maybe Location
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Location -> String -> Maybe Location
forall a b. a -> b -> a
const Maybe Location
forall a. Maybe a
Nothing) (Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location)
-> (S3Uri -> Location) -> S3Uri -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S3Uri -> Location
S3) (Text -> Either String S3Uri
forall a. FromText a => Text -> Either String a
fromText Text
txt')
| Text -> Text -> Bool
T.isPrefixOf Text
"file://" Text
txt' -> Location -> Maybe Location
forall a. a -> Maybe a
Just (String -> Location
Local (Text -> String
T.unpack Text
txt'))
| Text -> Text -> Bool
T.isPrefixOf Text
"http://" Text
txt' -> Location -> Maybe Location
forall a. a -> Maybe a
Just (Text -> Location
HttpUri Text
txt')
| Text -> Text -> Bool
T.isInfixOf Text
"://" Text
txt' -> Maybe Location
forall a. Maybe a
Nothing
| Bool
otherwise -> Location -> Maybe Location
forall a. a -> Maybe a
Just (String -> Location
Local (Text -> String
T.unpack Text
txt'))
where txt' :: Text
txt' = Text -> Text
T.strip Text
txt
stripStart :: Text -> Text -> Text
stripStart :: Text -> Text -> Text
stripStart Text
what Text
txt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
txt (Text -> Text -> Maybe Text
T.stripPrefix Text
what Text
txt)
stripEnd :: Text -> Text -> Text
stripEnd :: Text -> Text -> Text
stripEnd Text
what Text
txt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
txt (Text -> Text -> Maybe Text
T.stripSuffix Text
what Text
txt)