-- | Helper functions for creating Makefiles.
module Build.Drasil.Make.Helpers where

import Build.Drasil.Make.AST (Command(C), Rule(R))
import Build.Drasil.Make.MakeString (MakeString(Mc, Mr, Mv), MVar(Free, Implicit, Os))

import Data.List (nubBy)
import Text.PrettyPrint (Doc, empty, nest, text, vcat, ($+$))

-- | Assignment operator ("=").
($=) :: MVar -> String -> Doc
a :: MVar
a $= :: MVar -> String -> Doc
$= b :: String
b = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ MVar -> String
varName MVar
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b

-- | Extracts information for Windows OS from a variable.
win :: MVar -> String
win :: MVar -> String
win (Os _ w :: String
w _ _) = String
w
win _ = String -> String
forall a. HasCallStack => String -> a
error "Expected Os Variable"

-- | Extracts information for Mac OS from a variable.
mac :: MVar -> String
mac :: MVar -> String
mac (Os _ _ m :: String
m _) = String
m
mac _ = String -> String
forall a. HasCallStack => String -> a
error "Expected Os Variable"

-- | Extracts information for Linux OS from a variable.
linux :: MVar -> String
linux :: MVar -> String
linux (Os _ _ _ l :: String
l) = String
l
linux _ = String -> String
forall a. HasCallStack => String -> a
error "Expected Os Variable"

-- | Defines variables dependent on OS.
defineOsVars :: (MVar -> String) -> [MVar] -> Doc
defineOsVars :: (MVar -> String) -> [MVar] -> Doc
defineOsVars f :: MVar -> String
f m :: [MVar]
m = Doc -> Doc
msIndent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (MVar -> Doc) -> [MVar] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: MVar
x -> MVar
x MVar -> String -> Doc
$= MVar -> String
f MVar
x) [MVar]
m

-- | Helper for rendering OS-specific variables.
osDefinitions :: [MVar] -> Doc
osDefinitions :: [MVar] -> Doc
osDefinitions [] = Doc
empty
osDefinitions m :: [MVar]
m =
  String -> Doc
text "ifeq \"$(OS)\" \"Windows_NT\"" Doc -> Doc -> Doc
$+$
  (MVar -> String) -> [MVar] -> Doc
defineOsVars MVar -> String
win [MVar]
m Doc -> Doc -> Doc
$+$
  String -> Doc
text "else" Doc -> Doc -> Doc
$+$
  Doc -> Doc
msIndent ([Doc] -> Doc
vcat [String -> Doc
text "UNAME_S := $(shell uname -s)",
    String -> Doc
text "ifeq ($(UNAME_S), Linux)",
    (MVar -> String) -> [MVar] -> Doc
defineOsVars MVar -> String
linux [MVar]
m,
    String -> Doc
text "endif",
    String -> Doc
text "ifeq ($(UNAME_S), Darwin)",
    (MVar -> String) -> [MVar] -> Doc
defineOsVars MVar -> String
mac [MVar]
m,
    String -> Doc
text "endif"]) Doc -> Doc -> Doc
$+$
  String -> Doc
text "endif" Doc -> Doc -> Doc
$+$
  String -> Doc
text ""

-- | Deduplicates a list of variables and ensures duplicate variables have the same definition.
uniqueVars :: [MVar] -> [MVar]
uniqueVars :: [MVar] -> [MVar]
uniqueVars = (MVar -> MVar -> Bool) -> [MVar] -> [MVar]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\x :: MVar
x y :: MVar
y -> MVar -> String
varName MVar
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== MVar -> String
varName MVar
y Bool -> Bool -> Bool
&& (MVar
x MVar -> MVar -> Bool
forall a. Eq a => a -> a -> Bool
== MVar
y Bool -> Bool -> Bool
||
        String -> Bool
forall a. HasCallStack => String -> a
error ("Found disparate variable definitions for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MVar -> String
varName MVar
x)))

-- | Extracts the variable name from a Makefile variable.
varName :: MVar -> String
varName :: MVar -> String
varName (Free s :: String
s) = String
s
varName (Implicit s :: String
s) = String
s
varName (Os s :: String
s _ _ _) = String
s

-- | Extracts variables from a Makefile rule.
extractVars :: Rule -> [MVar]
extractVars :: Rule -> [MVar]
extractVars (R t :: Target
t d :: Dependencies
d _ cs :: [Command]
cs) = (Target -> [MVar]) -> Dependencies -> [MVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Target -> [MVar]
getVars (Dependencies -> [MVar]) -> Dependencies -> [MVar]
forall a b. (a -> b) -> a -> b
$ Target
t Target -> Dependencies -> Dependencies
forall a. a -> [a] -> [a]
: Dependencies
d Dependencies -> Dependencies -> Dependencies
forall a. [a] -> [a] -> [a]
++ (Command -> Target) -> [Command] -> Dependencies
forall a b. (a -> b) -> [a] -> [b]
map (\(C s :: Target
s _) -> Target
s) [Command]
cs

-- | Gets one or more variables from a MakeString.
getVars :: MakeString -> [MVar]
getVars :: Target -> [MVar]
getVars (Mr _) = []
getVars (Mv v :: MVar
v) = [MVar
v]
getVars (Mc a :: Target
a b :: Target
b) = Target -> [MVar]
getVars Target
a [MVar] -> [MVar] -> [MVar]
forall a. [a] -> [a] -> [a]
++ Target -> [MVar]
getVars Target
b

-- | Checks if a variable is OS dependent.
isOsVar :: MVar -> Bool
isOsVar :: MVar -> Bool
isOsVar Os{} = Bool
True
isOsVar _ = Bool
False

-- | Helper for prepending common features to a Makefile.
addCommonFeatures :: [Rule] -> Doc -> Doc
addCommonFeatures :: [Rule] -> Doc -> Doc
addCommonFeatures r :: [Rule]
r m :: Doc
m = [MVar] -> Doc
osDefinitions ((MVar -> Bool) -> [MVar] -> [MVar]
forall a. (a -> Bool) -> [a] -> [a]
filter MVar -> Bool
isOsVar ([MVar] -> [MVar]) -> [MVar] -> [MVar]
forall a b. (a -> b) -> a -> b
$ [MVar] -> [MVar]
uniqueVars ([MVar] -> [MVar]) -> [MVar] -> [MVar]
forall a b. (a -> b) -> a -> b
$ (Rule -> [MVar]) -> [Rule] -> [MVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule -> [MVar]
extractVars [Rule]
r) Doc -> Doc -> Doc
$+$ Doc
m

-- | Recipes must be indented with tabs.
tab :: Doc
tab :: Doc
tab = String -> Doc
text "\t"

-- | Makefile Syntax Indent (i.e. non recipes).
msIndent :: Doc -> Doc
msIndent :: Doc -> Doc
msIndent = Int -> Doc -> Doc
nest 4