{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Abstract representation for paths into modules.
module Data.GI.CodeGen.ModulePath
  ( ModulePath(..)
  , toModulePath
  , (/.)
  , dotModulePath
  ) where

#if !MIN_VERSION_base(4,13,0)
import Data.Monoid (Monoid(..), (<>))
#endif
import Data.String (IsString(..))
import qualified Data.Text as T
import qualified Data.Semigroup as Sem
import Data.Text (Text)

import Data.GI.CodeGen.Util (ucFirst)

-- | A path to a module.
newtype ModulePath = ModulePath { ModulePath -> [Text]
modulePathToList :: [Text] }
  deriving (NonEmpty ModulePath -> ModulePath
ModulePath -> ModulePath -> ModulePath
(ModulePath -> ModulePath -> ModulePath)
-> (NonEmpty ModulePath -> ModulePath)
-> (forall b. Integral b => b -> ModulePath -> ModulePath)
-> Semigroup ModulePath
forall b. Integral b => b -> ModulePath -> ModulePath
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ModulePath -> ModulePath
$cstimes :: forall b. Integral b => b -> ModulePath -> ModulePath
sconcat :: NonEmpty ModulePath -> ModulePath
$csconcat :: NonEmpty ModulePath -> ModulePath
<> :: ModulePath -> ModulePath -> ModulePath
$c<> :: ModulePath -> ModulePath -> ModulePath
Sem.Semigroup, Semigroup ModulePath
ModulePath
Semigroup ModulePath
-> ModulePath
-> (ModulePath -> ModulePath -> ModulePath)
-> ([ModulePath] -> ModulePath)
-> Monoid ModulePath
[ModulePath] -> ModulePath
ModulePath -> ModulePath -> ModulePath
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ModulePath] -> ModulePath
$cmconcat :: [ModulePath] -> ModulePath
mappend :: ModulePath -> ModulePath -> ModulePath
$cmappend :: ModulePath -> ModulePath -> ModulePath
mempty :: ModulePath
$cmempty :: ModulePath
Monoid, ModulePath -> ModulePath -> Bool
(ModulePath -> ModulePath -> Bool)
-> (ModulePath -> ModulePath -> Bool) -> Eq ModulePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModulePath -> ModulePath -> Bool
$c/= :: ModulePath -> ModulePath -> Bool
== :: ModulePath -> ModulePath -> Bool
$c== :: ModulePath -> ModulePath -> Bool
Eq, Int -> ModulePath -> ShowS
[ModulePath] -> ShowS
ModulePath -> String
(Int -> ModulePath -> ShowS)
-> (ModulePath -> String)
-> ([ModulePath] -> ShowS)
-> Show ModulePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModulePath] -> ShowS
$cshowList :: [ModulePath] -> ShowS
show :: ModulePath -> String
$cshow :: ModulePath -> String
showsPrec :: Int -> ModulePath -> ShowS
$cshowsPrec :: Int -> ModulePath -> ShowS
Show, Eq ModulePath
Eq ModulePath
-> (ModulePath -> ModulePath -> Ordering)
-> (ModulePath -> ModulePath -> Bool)
-> (ModulePath -> ModulePath -> Bool)
-> (ModulePath -> ModulePath -> Bool)
-> (ModulePath -> ModulePath -> Bool)
-> (ModulePath -> ModulePath -> ModulePath)
-> (ModulePath -> ModulePath -> ModulePath)
-> Ord ModulePath
ModulePath -> ModulePath -> Bool
ModulePath -> ModulePath -> Ordering
ModulePath -> ModulePath -> ModulePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModulePath -> ModulePath -> ModulePath
$cmin :: ModulePath -> ModulePath -> ModulePath
max :: ModulePath -> ModulePath -> ModulePath
$cmax :: ModulePath -> ModulePath -> ModulePath
>= :: ModulePath -> ModulePath -> Bool
$c>= :: ModulePath -> ModulePath -> Bool
> :: ModulePath -> ModulePath -> Bool
$c> :: ModulePath -> ModulePath -> Bool
<= :: ModulePath -> ModulePath -> Bool
$c<= :: ModulePath -> ModulePath -> Bool
< :: ModulePath -> ModulePath -> Bool
$c< :: ModulePath -> ModulePath -> Bool
compare :: ModulePath -> ModulePath -> Ordering
$ccompare :: ModulePath -> ModulePath -> Ordering
Ord)

-- | Construct a `ModulePath` from a `String`.
instance IsString ModulePath where
  fromString :: String -> ModulePath
fromString = Text -> ModulePath
toModulePath (Text -> ModulePath) -> (String -> Text) -> String -> ModulePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Construct a path into the given GIR namespace. The given `Text`
-- will be split along ".".
--
-- === __Examples__
-- >>> dotModulePath (toModulePath "Foo")
-- "Foo"
--
-- >>> dotModulePath ("Foo" <> toModulePath "Bar.Baz")
-- "Foo.Bar.Baz"
--
-- >>> dotModulePath ("Foo" <> toModulePath "bar.baz")
-- "Foo.Bar.Baz"
toModulePath :: Text -> ModulePath
toModulePath :: Text -> ModulePath
toModulePath Text
p = [Text] -> ModulePath
ModulePath ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
ucFirst ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
p))

-- | Turn a module path into the corresponding dotted string. Note
-- that the implementation ensures that the module names start with a
-- capital letter.
--
-- === __Examples__
-- >>> dotModulePath ("Foo" /. "Bar" /. "Baz")
-- "Foo.Bar.Baz"
--
-- >>> dotModulePath ("foo" /. "bar" /. "baz")
-- "Foo.Bar.Baz"
dotModulePath :: ModulePath -> Text
dotModulePath :: ModulePath -> Text
dotModulePath (ModulePath [Text]
mp) = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
mp

-- | Append the given component to the given module path.
--
-- === __Examples__
-- >>> dotModulePath ("Foo" /. "Bar")
-- "Foo.Bar"
(/.) :: ModulePath -> Text -> ModulePath
/. :: ModulePath -> Text -> ModulePath
(/.) ModulePath
mp Text
p = ModulePath
mp ModulePath -> ModulePath -> ModulePath
forall a. Semigroup a => a -> a -> a
<> Text -> ModulePath
toModulePath Text
p