{-| Types and path helpers.
    This is re-exported in the main `Shikensu` module.

-}
module Shikensu.Internal.Types where

import Data.Aeson ((.=), toJSON)
import Data.Aeson.KeyMap (KeyMap)
import Data.ByteString (ByteString)
import Data.Monoid ((<>))
import System.FilePath (joinPath)

import qualified Data.Aeson as Aeson (ToJSON, Value, object)


{-| A file definition, along with some additional properties.
-}
data Definition =
    Definition
        { Definition -> String
basename :: String
        , Definition -> String
dirname :: FilePath
        , Definition -> String
extname :: String
        , Definition -> String
pattern :: String
        , Definition -> String
rootDirname :: FilePath
        , Definition -> String
workingDirname :: FilePath

        -- Additional properties
        , Definition -> Maybe ByteString
content :: Maybe ByteString
        , Definition -> Metadata
metadata :: Metadata
        , Definition -> Maybe String
parentPath :: Maybe FilePath
        , Definition -> String
pathToRoot :: FilePath
        } deriving (Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c== :: Definition -> Definition -> Bool
Eq, Int -> Definition -> ShowS
[Definition] -> ShowS
Definition -> String
(Int -> Definition -> ShowS)
-> (Definition -> String)
-> ([Definition] -> ShowS)
-> Show Definition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Definition] -> ShowS
$cshowList :: [Definition] -> ShowS
show :: Definition -> String
$cshow :: Definition -> String
showsPrec :: Int -> Definition -> ShowS
$cshowsPrec :: Int -> Definition -> ShowS
Show)


instance Aeson.ToJSON Definition where
    toJSON :: Definition -> Value
toJSON Definition
def =
        [Pair] -> Value
Aeson.object
            [ Key
"basename"        Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> String
basename Definition
def
            , Key
"dirname"         Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> String
dirname Definition
def
            , Key
"extname"         Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> String
extname Definition
def
            , Key
"pattern"         Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> String
pattern Definition
def
            , Key
"workingDirname"  Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> String
workingDirname Definition
def
            , Key
"parentPath"      Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> Maybe String
parentPath Definition
def
            , Key
"pathToRoot"      Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Definition -> String
pathToRoot Definition
def
            ]



-- Type aliases


type Dictionary = [Definition]
type Metadata = KeyMap Aeson.Value



-- Path functions


absolutePath :: Definition -> String
absolutePath :: Definition -> String
absolutePath Definition
def =
    [String] -> String
joinPath [Definition -> String
rootDirname Definition
def, Definition -> String
workspacePath Definition
def]


localPath :: Definition -> String
localPath :: Definition -> String
localPath Definition
def =
    [String] -> String
joinPath [Definition -> String
dirname Definition
def, Definition -> String
basename Definition
def String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Definition -> String
extname Definition
def]


workspacePath :: Definition -> String
workspacePath :: Definition -> String
workspacePath Definition
def =
    [String] -> String
joinPath [Definition -> String
workingDirname Definition
def, Definition -> String
localPath Definition
def]