-- MCM - Machine Configuration Manager; manages the contents of files and directories
-- Copyright (c) 2013-2018 Anthony Doggett <mcm@interfaces.org.uk>
--
-- Licence:
--     This program is free software: you can redistribute it and/or modify
--     it under the terms of the GNU 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 General Public License for more details.
--
--     You should have received a copy of the GNU General Public License
--     along with this program.  If not, see <http://www.gnu.org/licenses/>.

module ParserTypes (Import(..), PackagePath(..), dummyPP, packagePath, Ident(..), Value(..), UnexpandedDefName(..), DefName(..), dummyDefName, Locals(..), OptArgs(..), CondLocal(..), Define(..), Section(..), section, imports, lookupDefine, lookupImport, InvocationCmd(..), ExpandedInvocationCmd(..), InvocationArgs(..), MCMFile(..), Invocation(..), Group(..), Separator(..), Prepend(..), Append(..), ContentLine(..), Content(..), ContentType(..), toContent, VarsExpand(..)) where

import Data.Char (isAlpha)
import Data.List (find, intercalate)
import qualified Data.Map as Map
import qualified Data.Text.Lazy as T
import System.FilePath (joinPath)

-- For translating the full PackagePath into a short name
data Import = Import PackagePath T.Text
    deriving (Show, Eq)

lookupImport :: [Import] -> T.Text -> Maybe PackagePath
lookupImport is i =
    case find (\(Import _ s) -> i==s) is of
        Nothing -> Nothing
        Just (Import pp _) -> Just pp

newtype PackagePath = PackagePath [T.Text]
    deriving (Eq, Ord)

dummyPP :: PackagePath
dummyPP = PackagePath []

instance Show PackagePath where
    show (PackagePath pp) = intercalate "." $ map T.unpack pp

packagePath :: PackagePath -> FilePath
packagePath (PackagePath pp) = joinPath (map T.unpack pp) ++ ".mcm"

newtype Ident = Ident {fromIdent :: T.Text}
    deriving (Eq, Ord)
newtype Value = Value T.Text
    deriving (Eq, Ord)
newtype DefName = DefName {fromDefName :: T.Text}
    deriving (Eq, Ord)
-- UnexpandedDefName is like DefName but can contain one or more @-vars that need expanding
newtype UnexpandedDefName = UnexpandedDefName {fromUnexpandedDefName :: T.Text}
    deriving (Eq, Ord)

dummyDefName :: DefName
dummyDefName = (DefName . T.pack) "<init>"

instance Show Ident where
    show (Ident i) = T.unpack i
instance Show Value where
    show (Value v) = T.unpack v
instance Show DefName where
    show (DefName d) = T.unpack d
instance Show UnexpandedDefName where
    show (UnexpandedDefName d) = T.unpack d

newtype Locals = Locals {fromLocals :: Map.Map Ident [Content]}
    deriving (Show, Eq)

newtype OptArgs = OptArgs{fromOptArgs :: Map.Map Ident [Content]}
    deriving (Show, Eq)

data CondLocal = CondLocal Ident (Map.Map Value Locals)
    deriving (Show, Eq)

data Define = Define {defName :: DefName
                     ,defArgs :: [Ident]
                     ,defOptargs :: OptArgs
                     ,defLocals :: Locals
                     ,defCondlocals :: [CondLocal]
                     ,defInvokes :: [Invocation]
                     }
    deriving (Show, Eq)

lookupDefine :: Section -> DefName -> Maybe Define
lookupDefine (Section _ _ ds) dname = Map.lookup dname ds

data InvocationCmd = InvFile | InvDir | InvAbsent | InvFragment | InvSymlink
                       | InvLocal UnexpandedDefName | InvImport T.Text UnexpandedDefName
    deriving (Show, Eq, Ord)

data ExpandedInvocationCmd = ExInvFile | ExInvDir | ExInvAbsent | ExInvFragment
        | ExInvSymlink | ExInvLocal DefName | ExInvImport T.Text DefName
    deriving (Show, Eq, Ord)

newtype InvocationArgs = InvocationArgs {fromInvocationArgs :: Map.Map Ident [Content]}
    deriving (Show, Eq)
data Invocation = Invocation InvocationCmd InvocationArgs
    deriving (Show, Eq)

data MCMFile = MCMFile PackagePath Section deriving Show

section :: MCMFile -> Section
section (MCMFile _ s) = s

data Section = Section [Import] (Map.Map Ident [Content]) (Map.Map DefName Define)
    deriving (Show, Eq)

imports :: Section -> [Import]
imports (Section imps _ _) = imps

newtype Group = Group T.Text deriving (Eq, Ord)
newtype Separator = Separator T.Text deriving (Eq, Ord)
newtype Prepend = Prepend T.Text deriving (Eq, Ord)
newtype Append = Append T.Text deriving (Eq, Ord)

instance Show Group where
    show (Group g) = T.unpack g
instance Show Separator where
    show (Separator s) = T.unpack s
instance Show Prepend where
    show (Prepend p) = T.unpack p
instance Show Append where
    show (Append a) = T.unpack a

data ContentLine = Plain T.Text
                 | PrependNewline T.Text

data ContentType = CTSpace | CTDollar

toContent :: Int -> ContentType -> ContentLine -> Either String [Content]
toContent lineno ct (PrependNewline s) =
    case toContent lineno ct (Plain s) of
        Left e -> Left e
        Right cs -> Right $ CNewline : cs
toContent _ _ (Plain s) | T.null s = Right []
toContent lineno ct (Plain s) =
    case ct of
        CTSpace -> return [CString s]
        CTDollar -> case T.span isAlpha s of
            (a, b) | a == T.pack "file"      && T.head b == '(' -> checkEnd (\ss -> Right [CFile ss]) $ T.tail b
            (a, b) | a == T.pack "rawfile"   && T.head b == '(' -> checkEnd (\ss -> Right [CRawFile ss]) $ T.tail b
            (a, b) | a == T.pack "rawstring" && T.head b == '(' -> checkEnd (\ss -> Right [CRawString ss]) $ T.tail b
            (a, b) | a == T.pack "string"    && T.head b == '(' -> checkEnd (\ss -> Right [CExplicitString ss]) $ T.tail b
            (a, b) | a == T.pack "fragments" && T.head b == '(' -> checkEnd makeFragments $ T.tail b
            (a, b) | a == T.pack "numformat" && T.head b == '(' -> checkEnd makeNumFormat $ T.tail b
            (a, b) | a == T.pack "linn"      && T.head b == '(' -> checkEnd makeLinn $ T.tail b
            _ -> Left $ "Expected a valid $COMMAND but got: $" ++ T.unpack s
        where
            checkEnd f ss = if T.last ss == ')'
                            then f $ T.init ss
                            else Left $ "Content missing final ')'? : " ++ T.unpack ss
            makeNumFormat ss =
                let fargs = T.split (== ',') ss
                    [format, number] = fargs
                in
                    if length fargs == 2
                        then Right [CNumFormat format number]
                        else Left $ "Wrong number of numformat arguments: " ++ T.unpack ss
            makeFragments ss =
                let fargs = T.split (== ',') ss
                    [g, prepend, append, sep] = fargs
                in
                    if length fargs == 4
                        then Right [CFragments (Group g) (Prepend prepend) (Append append) (Separator sep)]
                        else Left $ "Wrong number of fragments arguments: " ++ T.unpack ss
            makeLinn ss | T.null ss = Right [CLinn lineno]
            makeLinn ss = Left $ "$linn expects 0 arguments, but received: " ++ T.unpack ss

data Content = CString T.Text -- As input
             | CExplicitString T.Text -- As input within explicit string()
             | CRawString T.Text -- String on which to perform no expansion
             | CEmpty -- Nothing
             | CNewline -- A newline
             | CFile T.Text
             | CFragments Group Prepend Append Separator
             | CNumFormat T.Text T.Text
             | CLinn Int
             | CRawFile T.Text
    deriving (Show, Eq)

data VarsExpand a = VarsExpand {vexpand :: Ident -> T.Text -> Maybe a
                               ,vnoexpand :: T.Text -> a
                               ,vcollapse :: [a] -> a
                               ,vescapeexpand :: T.Text -> T.Text -> a
                               }