-- | Defines printers for generating Makefiles.
module Build.Drasil.Make.Print where

import Prelude hiding ((<>))
import Text.PrettyPrint (Doc, empty, text, (<>), (<+>), ($+$), ($$), hsep, vcat)

import qualified Data.Text as T
import Text.Wrap

import Build.Drasil.Make.AST (Annotation, Command(C), 
  CommandOpts(IgnoreReturnCode), Dependencies, Makefile(M), Rule(R), Target, 
  Type(Abstract))
import Build.Drasil.Make.Helpers (addCommonFeatures, tab)
import Build.Drasil.Make.Import (RuleTransformer, toMake)
import Build.Drasil.Make.MakeString (renderMS)
import CodeLang.Drasil (Comment)

-- | Generates the makefile by calling 'build' after 'toMake'.
genMake :: RuleTransformer c => [c] -> Doc
genMake :: forall c. RuleTransformer c => [c] -> Doc
genMake = Makefile -> Doc
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. RuleTransformer c => [c] -> Makefile
toMake

-- | Renders the makefile rules.
build :: Makefile -> Doc
build :: Makefile -> Doc
build (M [Rule]
rules) = [Rule] -> Doc -> Doc
addCommonFeatures [Rule]
rules forall a b. (a -> b) -> a -> b
$
  [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (\Rule
x -> Rule -> Doc
printRule Rule
x Doc -> Doc -> Doc
$+$ String -> Doc
text String
"") [Rule]
rules) Doc -> Doc -> Doc
$$ [Rule] -> Doc
printPhony [Rule]
rules

-- | Renders specific makefile rules. Called by 'build'.
printRule :: Rule -> Doc
printRule :: Rule -> Doc
printRule (R Annotation
c Target
t Dependencies
d Type
_ [Command]
cmd) = Annotation -> Doc
printComments Annotation
c Doc -> Doc -> Doc
$+$ Target -> Dependencies -> Doc
printTarget Target
t Dependencies
d Doc -> Doc -> Doc
$+$ [Command] -> Doc
printCmds [Command]
cmd

-- | Renders a makefile comment
printComment :: Comment -> Doc
printComment :: String -> Doc
printComment [] = Doc
empty
printComment String
c  = String -> Doc
text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (WrapSettings -> Int -> Text -> Text
wrapText WrapSettings
wrapSettings Int
80 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
c) forall a. [a] -> [a] -> [a]
++ String
"\n"

wrapSettings :: WrapSettings
wrapSettings :: WrapSettings
wrapSettings = WrapSettings { preserveIndentation :: Bool
preserveIndentation = Bool
True
                 , breakLongWords :: Bool
breakLongWords = Bool
False
                 , fillStrategy :: FillStrategy
fillStrategy = Text -> FillStrategy
FillPrefix (String -> Text
T.pack String
"# ")
                 , fillScope :: FillScope
fillScope = FillScope
FillAll
                 }

-- | Renders multiple comments
printComments :: Annotation -> Doc
printComments :: Annotation -> Doc
printComments = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
printComment) Doc
empty

-- | Gathers all rules to abstract targets and tags them as phony.
printPhony :: [Rule] -> Doc
printPhony :: [Rule] -> Doc
printPhony = Doc -> Doc -> Doc
(<+>) (String -> Doc
text String
".PHONY:") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(R Annotation
_ Target
t Dependencies
_ Type
_ [Command]
_) -> String -> Doc
text forall a b. (a -> b) -> a -> b
$ Target -> String
renderMS Target
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. (a -> Bool) -> [a] -> [a]
filter (\(R Annotation
_ Target
_ Dependencies
_ Type
t [Command]
_) -> Type
t forall a. Eq a => a -> a -> Bool
== Type
Abstract)

-- | Renders targets with their dependencies.
printTarget :: Target -> Dependencies -> Doc
printTarget :: Target -> Dependencies -> Doc
printTarget Target
nameLb Dependencies
deps = String -> Doc
text (Target -> String
renderMS Target
nameLb forall a. [a] -> [a] -> [a]
++ String
":") Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> String
renderMS) Dependencies
deps)

-- | Renders a makefile command.
printCmd :: Command -> Doc
printCmd :: Command -> Doc
printCmd (C Target
c [CommandOpts]
opts) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ (if CommandOpts
IgnoreReturnCode forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandOpts]
opts then String
"-" else String
"") forall a. [a] -> [a] -> [a]
++ Target -> String
renderMS Target
c

-- | Renders multiple commands.
printCmds :: [Command] -> Doc
printCmds :: [Command] -> Doc
printCmds = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc
(<>) Doc
tab forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Doc
printCmd) Doc
empty