Base.hs

-- This file is part of khph.
--
-- Copyright 2016 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}

-- | Core data types for a project.
module Khph.Project.Base (
  -- * Project paths
  ProjectPath,
  toProjectPath,
  projectPathFromComponents,
  projectPathToComponents,
  projectPathToRelativePath,
  projectPathAppend,
  projectPathAppendComponents,
  projectPathDropLastComponent,
  projectPathIsPrefixOf,
  -- * Tags
  Tag,
  toTag,
  tagToProjectPath,
  tagToComponents,
  tagToRelativePath,
  -- * Entry lookup
  EntrySpec (..),
  toEntrySpec,
  ) where

import Data.Function (on)
import Data.List (intercalate, intersperse, isPrefixOf)
import Khph.Util
import System.FilePath (isPathSeparator, isRelative, pathSeparator)

-- | A project path is a relative path from a project's root directory,
-- normalized so that there are no @.@ or @..@ components.
data ProjectPath = ProjectPath
  { projectPathToComponents :: [String]
    -- ^ Returns the individual path components.
  } deriving (Eq, Ord)

instance Show ProjectPath where
  show x = concat $
           "<ProjectPath " :
           intersperse [pathSeparator] (projectPathToComponents x) ++
           [">"]

-- | Converts a project-relative 'FilePath' into a 'ProjectPath'.  Errors if
-- given an absolute path.
toProjectPath :: FilePath -> ProjectPath
toProjectPath path =
  if isRelative path
  then projectPathFromComponents $ splitPath path
  else error $ concat
       ["toProjectPath: Expected a relative path, got ", show path, "."]

-- | Creates a 'ProjectPath' from a list of path components.  Removes empty
-- components.
projectPathFromComponents :: [String] -> ProjectPath
projectPathFromComponents =
  ProjectPath . filter (not . null)  -- The filter here is defensive.

-- | Converts a 'ProjectPath' to a 'FilePath' relative to the project root.
projectPathToRelativePath :: ProjectPath -> FilePath
projectPathToRelativePath projectPath =
  case intercalate [pathSeparator] $ projectPathToComponents projectPath of
    "" -> "."
    path -> path

-- | Appends the components from a 'FilePath' on to the end of a 'ProjectPath'.
projectPathAppend :: ProjectPath -> FilePath -> ProjectPath
projectPathAppend projectPath suffix =
  projectPathAppendComponents projectPath $ splitPath suffix

-- | Appends path components onto a 'ProjectPath'.
projectPathAppendComponents :: ProjectPath -> [String] -> ProjectPath
projectPathAppendComponents projectPath components =
  projectPathFromComponents $
  (++ components) $
  projectPathToComponents projectPath

-- | Drops the last component of a file path.
projectPathDropLastComponent :: ProjectPath -> ProjectPath
projectPathDropLastComponent (ProjectPath xs) = ProjectPath $ butLast xs

-- | @projectPathIsPrefixOf p1 p2@ returns whether @p1@ is either equal to @p2@
-- or is an ancestor of @p2@.
projectPathIsPrefixOf :: ProjectPath -> ProjectPath -> Bool
projectPathIsPrefixOf = isPrefixOf `on` projectPathToComponents

-- | A tag is a link outside of all project source directories to a file inside
-- a source directory.  Both the link and the file may be either hard or soft
-- links.
newtype Tag = Tag
  { tagToProjectPath :: ProjectPath
    -- ^ Returns the 'ProjectPath' underlying a 'Tag'.
  } deriving (Eq, Ord)

instance Show Tag where
  show tag = concat ["<Tag ", tagToRelativePath tag, ">"]

-- | You should probably use 'tagParse' instead of this function.
toTag :: ProjectPath -> Either String Tag
toTag projectPath@(ProjectPath components) = case components of
  [] -> Left "toTag: An empty project path may not be a tag."
  _ -> Right $ Tag projectPath

-- | Shortcut for @'projectPathToComponents' . 'tagToProjectPath'@.
tagToComponents :: Tag -> [String]
tagToComponents = projectPathToComponents . tagToProjectPath

-- | Shortcut for @'projectPathToRelativePath' . 'tagToProjectPath'@.
tagToRelativePath :: Tag -> String
tagToRelativePath = projectPathToRelativePath . tagToProjectPath

-- | A textual, user-friendly pattern that matches zero or more entries in a
-- project.  A 'EntrySpec' can be absolute, relative, or by-name.  Absolute
-- 'EntrySpec's represent a single path from the root of the project to a
-- possible entry.  Relative 'EntrySpec's represent a single path from the
-- current working directory to a possible entry.  By-name 'EntrySpec's store
-- only a single file name, and refer to all entries that have that name in
-- their last component of some path.
--
-- The textual format for a 'EntrySpec' is as follows.  The string may not be
-- empty.  Strings that begin with a path separator (see 'isPathSeparator') are
-- absolute.  Strings that begin with @.@ then a path separator are relative.
-- Otherwise, strings that contain a path separator are absolute and strings
-- that do not are relative.  This may be relaxed in the future by making
-- additional strings not starting with a path separator to be not absolute.
data EntrySpec =
    EntrySpecAbsolute [String]
  | EntrySpecRelative [String]
  | EntrySpecByName String
  deriving (Eq)

instance Show EntrySpec where
  show spec = case spec of
    EntrySpecAbsolute components ->
      concat $ "<EntrySpec " : map (pathSeparator:) components ++ [">"]
    EntrySpecRelative components ->
      concat $ "<EntrySpec ." : map (pathSeparator:) components ++ [">"]
    EntrySpecByName name ->
      concat ["<EntrySpec ", name, ">"]

-- | Parses an 'EntrySpec', returning an error message if the parse fails.
toEntrySpec :: String -> Either String EntrySpec
toEntrySpec str = case str of
  [] -> Left "toEntrySpec: An empty entry specification is invalid."
  c:[] | isPathSeparator c -> Right $ EntrySpecAbsolute []
  c:rest | isPathSeparator c -> Right $ EntrySpecAbsolute $ splitPath rest
  '.':[] -> Right $ EntrySpecRelative []
  '.':c:rest | isPathSeparator c -> Right $ EntrySpecRelative $ splitPath rest
  _ -> if any isPathSeparator str
       then Right $ EntrySpecAbsolute $ splitPath str
       else Right $ EntrySpecByName str