{-# LANGUAGE DefaultSignatures, OverloadedStrings #-}

module HsDev.Symbols.Documented (
	Documented(..),
	defaultDetailed
	) where

import Control.Lens (view, (^..), (^?))
import Data.Maybe (maybeToList)
import Data.Text (Text, pack)
import qualified Data.Text as T

import Text.Format
import HsDev.Symbols.Class
import HsDev.Project.Types

-- | Documented symbol
class Documented a where
	brief :: a -> Text
	detailed :: a -> Text
	default detailed :: Sourced a => a -> Text
	detailed = [Text] -> Text
T.unlines ([Text] -> Text) -> (a -> [Text]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Text]
forall a. (Sourced a, Documented a) => a -> [Text]
defaultDetailed

-- | Default detailed docs
defaultDetailed :: (Sourced a, Documented a) => a -> [Text]
defaultDetailed :: a -> [Text]
defaultDetailed a
s = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]
header, [Text]
docs, [Text]
loc] where
	header :: [Text]
header = [a -> Text
forall a. Documented a => a -> Text
brief a
s, Text
""]
	docs :: [Text]
docs = a
s a -> Getting (Endo [Text]) a Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Text]) a Text
forall a. Sourced a => Traversal' a Text
sourcedDocs
	loc :: [Text]
loc = [Text] -> (Position -> [Text]) -> Maybe Position -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Position
l -> [Text
"Defined at " Text -> Text -> Text
`T.append` String -> Text
pack (Position -> String
forall a. Show a => a -> String
show Position
l)]) (a
s a -> Getting (First Position) a Position -> Maybe Position
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Position) a Position
forall a. Sourced a => Traversal' a Position
sourcedLocation)

instance Documented ModulePackage where
	brief :: ModulePackage -> Text
brief = String -> Text
pack (String -> Text)
-> (ModulePackage -> String) -> ModulePackage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModulePackage -> String
forall a. Show a => a -> String
show
	detailed :: ModulePackage -> Text
detailed = ModulePackage -> Text
forall a. Documented a => a -> Text
brief

instance Documented ModuleLocation where
	brief :: ModuleLocation -> Text
brief (FileModule Text
f Maybe Project
_) = Text
f
	brief (InstalledModule [Text]
_ ModulePackage
pkg Text
n Bool
_) = String -> Format
forall r. FormatResult r => String -> r
format String
"{} from {}" Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
n Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModulePackage -> Text
forall a. Documented a => a -> Text
brief ModulePackage
pkg
	brief (OtherLocation Text
src) = Text
src
	brief ModuleLocation
NoLocation = Text
"<no-location>"
	detailed :: ModuleLocation -> Text
detailed (FileModule Text
f Maybe Project
mproj) = case Maybe Project
mproj of
		Maybe Project
Nothing -> Text
f
		Just Project
proj -> String -> Format
forall r. FormatResult r => String -> r
format String
"{} in project {}" Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
f Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Project -> Text
forall a. Documented a => a -> Text
brief Project
proj
	detailed (InstalledModule [Text]
pdb ModulePackage
pkg Text
n Bool
_) = String -> Format
forall r. FormatResult r => String -> r
format String
"{} from {} ({})" Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
n Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModulePackage -> Text
forall a. Documented a => a -> Text
brief ModulePackage
pkg Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> String
forall a. Show a => a -> String
show [Text]
pdb
	detailed ModuleLocation
l = ModuleLocation -> Text
forall a. Documented a => a -> Text
brief ModuleLocation
l

instance Documented Project where
	brief :: Project -> Text
brief Project
p = String -> Format
forall r. FormatResult r => String -> r
format String
"{} ({})" Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectName Project
p Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectPath Project
p
	detailed :: Project -> Text
detailed Project
p = [Text] -> Text
T.unlines (Project -> Text
forall a. Documented a => a -> Text
brief Project
p Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
desc) where
		desc :: [Text]
desc = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
			do
				ProjectDescription
d <- [ProjectDescription]
mdescr
				Library
_ <- Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList (Maybe Library -> [Library]) -> Maybe Library -> [Library]
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Library) ProjectDescription (Maybe Library)
-> ProjectDescription -> Maybe Library
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Library) ProjectDescription (Maybe Library)
Lens' ProjectDescription (Maybe Library)
projectLibrary ProjectDescription
d
				Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\tlibrary",
			do
				ProjectDescription
d <- [ProjectDescription]
mdescr
				Executable
exe <- Getting [Executable] ProjectDescription [Executable]
-> ProjectDescription -> [Executable]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Executable] ProjectDescription [Executable]
Lens' ProjectDescription [Executable]
projectExecutables ProjectDescription
d
				Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Format
forall r. FormatResult r => String -> r
format String
"\texecutable: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Getting Text Executable Text -> Executable -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Executable Text
Lens' Executable Text
executableName Executable
exe,
			do
				ProjectDescription
d <- [ProjectDescription]
mdescr
				Test
test <- Getting [Test] ProjectDescription [Test]
-> ProjectDescription -> [Test]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Test] ProjectDescription [Test]
Lens' ProjectDescription [Test]
projectTests ProjectDescription
d
				Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Format
forall r. FormatResult r => String -> r
format String
"\ttest: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Getting Text Test Text -> Test -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Test Text
Lens' Test Text
testName Test
test]
		mdescr :: [ProjectDescription]
mdescr = Maybe ProjectDescription -> [ProjectDescription]
forall a. Maybe a -> [a]
maybeToList (Maybe ProjectDescription -> [ProjectDescription])
-> Maybe ProjectDescription -> [ProjectDescription]
forall a b. (a -> b) -> a -> b
$ Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
-> Project -> Maybe ProjectDescription
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
Lens' Project (Maybe ProjectDescription)
projectDescription Project
p