{- |
Copyright:  (c) 2017-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Contains main data types used in the project.
-}

module Life.Core
    (
      -- * Git and Github core
      Branch (..)
    , Owner  (..)
    , Repo   (..)
    , CommitMsg (..)
    , master

      -- * File system logic
    , CopyDirection (..)
    , LifePath (..)
    ) where

----------------------------------------------------------------------------
-- Git and Github core
----------------------------------------------------------------------------

-- | Github repository owner.
newtype Owner = Owner
    { Owner -> Text
unOwner :: Text
    } deriving stock (Int -> Owner -> ShowS
[Owner] -> ShowS
Owner -> String
(Int -> Owner -> ShowS)
-> (Owner -> String) -> ([Owner] -> ShowS) -> Show Owner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Owner] -> ShowS
$cshowList :: [Owner] -> ShowS
show :: Owner -> String
$cshow :: Owner -> String
showsPrec :: Int -> Owner -> ShowS
$cshowsPrec :: Int -> Owner -> ShowS
Show)

-- | Git repository.
newtype Repo  = Repo
    { Repo -> Text
unRepo :: Text
    } deriving stock (Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> String
(Int -> Repo -> ShowS)
-> (Repo -> String) -> ([Repo] -> ShowS) -> Show Repo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repo] -> ShowS
$cshowList :: [Repo] -> ShowS
show :: Repo -> String
$cshow :: Repo -> String
showsPrec :: Int -> Repo -> ShowS
$cshowsPrec :: Int -> Repo -> ShowS
Show)

-- | Git branch.
newtype Branch = Branch
    { Branch -> Text
unBranch :: Text
    } deriving stock (Int -> Branch -> ShowS
[Branch] -> ShowS
Branch -> String
(Int -> Branch -> ShowS)
-> (Branch -> String) -> ([Branch] -> ShowS) -> Show Branch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Branch] -> ShowS
$cshowList :: [Branch] -> ShowS
show :: Branch -> String
$cshow :: Branch -> String
showsPrec :: Int -> Branch -> ShowS
$cshowsPrec :: Int -> Branch -> ShowS
Show)
      deriving newtype (Branch -> Branch -> Bool
(Branch -> Branch -> Bool)
-> (Branch -> Branch -> Bool) -> Eq Branch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Branch -> Branch -> Bool
$c/= :: Branch -> Branch -> Bool
== :: Branch -> Branch -> Bool
$c== :: Branch -> Branch -> Bool
Eq)

-- | Git commit message.
newtype CommitMsg = CommitMsg
    { CommitMsg -> Text
unCommitMsg :: Text
    } deriving stock (Int -> CommitMsg -> ShowS
[CommitMsg] -> ShowS
CommitMsg -> String
(Int -> CommitMsg -> ShowS)
-> (CommitMsg -> String)
-> ([CommitMsg] -> ShowS)
-> Show CommitMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitMsg] -> ShowS
$cshowList :: [CommitMsg] -> ShowS
show :: CommitMsg -> String
$cshow :: CommitMsg -> String
showsPrec :: Int -> CommitMsg -> ShowS
$cshowsPrec :: Int -> CommitMsg -> ShowS
Show)

-- | Git "master" branch constant.
master :: Branch
master :: Branch
master = Text -> Branch
Branch "master"

----------------------------------------------------------------------------
-- File system logic
----------------------------------------------------------------------------

data CopyDirection
    = FromHomeToRepo
    | FromRepoToHome

data LifePath
    = File FilePath
    | Dir FilePath
    deriving stock (Int -> LifePath -> ShowS
[LifePath] -> ShowS
LifePath -> String
(Int -> LifePath -> ShowS)
-> (LifePath -> String) -> ([LifePath] -> ShowS) -> Show LifePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LifePath] -> ShowS
$cshowList :: [LifePath] -> ShowS
show :: LifePath -> String
$cshow :: LifePath -> String
showsPrec :: Int -> LifePath -> ShowS
$cshowsPrec :: Int -> LifePath -> ShowS
Show)