mcm-0.6.8.1: PathToMCM.hs

-- 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 PathToMCM (pathToMcm)
where

import qualified Data.Text.Lazy as T
import Numeric (showOct)

import FileCorrector(Path, walk, PathType(..), Permissions(..), DirType(..), ownerAsString, groupAsString)

type PT = (FilePath, PathType, Permissions)

pathToMcm :: String -> String -> Path -> ShowS
pathToMcm package define p = s . showl toMcm (walk p)
    where
        s = showString "MCM " . showString package . showString "\n\n" .
            showString "define " . showString define . showString "()\n"
        showl :: (PT -> ShowS) -> [PT] -> ShowS
        showl _ [] = id
        showl f (x:xs) = f x . showl f xs

s1 :: ShowS
s1 = showString "\t"

s2 :: ShowS
s2 = s1 . s1

s3 :: ShowS
s3 = s2 . s1

-- Like prelude's "lines", but does care whether the last line ends '\n'
linesN :: String -> [String]
linesN "" = []
linesN s  = linesN' s
linesN' :: String -> [String]
linesN' "" = [""]
linesN' s  = let (l, s') = break (== '\n') s
             in l : case s' of
                        []      -> []
                        (_:s'') -> linesN' s''

-- Append the permissions lines to the Absent/File/Directory
perms :: Permissions -> ShowS
perms (Perm mf mu mg) = f . u . g
    where
        f = case mf of
                Nothing -> id
                Just s -> showString " mode> " .
                            showOct s
        u = case mu of
                Nothing -> id
                Just s -> showString " owner> " .
                            (ownerAsString s ++)
        g = case mg of
                Nothing -> id
                Just s -> showString " group> " .
                            (groupAsString s ++)

raw :: String -> ShowS
raw s = showString "$rawstring(" . showString s . showString ")\n"

rawcontinuations :: [String] -> ShowS
rawcontinuations [] = id
rawcontinuations (x:xs) =
    s3 . showString "+" . raw x . rawcontinuations xs

toMcm :: PT -> ShowS
toMcm (fp, Absent, perm) = showString "" .
    s1 . showString "Absent" . perms perm .
        showString " path:" . raw fp
toMcm (fp, File f, perm) =
    s1 . showString "File" . perms perm .
        showString " path:" . raw fp .
        s2 . showString "content:" . raw first .
        rawcontinuations rest
    where
        (first,rest) = case f' of
                        [] -> ("",[])
                        (x:xs) -> (x, xs)
        f' = linesN . T.unpack $ f
toMcm (_, Dir Implicit, _) = id
toMcm (fp, Dir dt, perm) =
    s1 . showString "Dir" . perms perm .
        showString " manage> " . showString d .
        showString " path:" . raw fp
    where
        d = case dt of
                Partial -> "partial"
                Full -> "full"
                Implicit -> error "Impossible"
toMcm (fp, Symlink sfp, perm) =
    s1 . showString "Symlink" . perms perm .
        showString " path:" . raw fp .
        s2 . showString "link:" . raw sfp