module Linspire.Debian.Control.Common
    ( -- * Types
      Control'(..)
    , Paragraph'(..)
    , Field'(..)
    , ControlFunctions(..)
    , mergeControls
    , fieldValue
    , removeField
    , prependFields
    , appendFields
    , renameField
    , modifyField
    , raiseFields,
    )
    where

import Text.ParserCombinators.Parsec
import System.IO
import Data.List

newtype Control' a
    = Control { unControl :: [Paragraph' a] }

newtype Paragraph' a
    = Paragraph [Field' a]

-- |NOTE: we do not strip the leading or trailing whitespace in the
-- name or value
data Field' a
    = Field (a, a)
    | Comment a
      deriving Eq

class ControlFunctions a where
    -- |'parseControlFromFile' @filepath@ is a simple wrapper function
    -- that parses @filepath@ using 'pControl'
    parseControlFromFile :: FilePath -> IO (Either ParseError (Control' a))
    -- |'parseControlFromHandle' @sourceName@ @handle@ - @sourceName@ is only used for error reporting
    parseControlFromHandle :: String -> Handle -> IO (Either ParseError (Control' a))
    -- | 'lookupP' @fieldName paragraph@ looks up a 'Field' in a 'Paragraph'.
    -- @N.B.@ trailing and leading whitespace is /not/ stripped.
    lookupP :: String -> (Paragraph' a) -> Maybe (Field' a)
    -- |Strip the trailing and leading space and tab characters from a
    -- string. Folded whitespace is /not/ unfolded. This should probably
    -- be moved to someplace more general purpose.
    stripWS :: a -> a

mergeControls :: [Control' a] -> Control' a
mergeControls controls =
    Control (concatMap unControl controls)

fieldValue :: (ControlFunctions a) => String -> Paragraph' a -> Maybe a
fieldValue fieldName paragraph =
    fmap value (lookupP fieldName paragraph)
    where value (Field (_, val)) = stripWS val

removeField :: (Eq a) => a -> Paragraph' a -> Paragraph' a
removeField toRemove (Paragraph fields) =
    Paragraph (filter remove fields)
    where
      remove (Field (name,_)) = name == toRemove

prependFields :: [Field' a] -> Paragraph' a -> Paragraph' a
prependFields newfields (Paragraph fields) = Paragraph (newfields ++ fields)

appendFields :: [Field' a] -> Paragraph' a -> Paragraph' a
appendFields newfields (Paragraph fields) = Paragraph (fields ++ newfields)

renameField :: (Eq a) => a -> a -> Paragraph' a -> Paragraph' a
renameField oldname newname (Paragraph fields) =
    Paragraph (map rename fields)
    where
      rename (Field (name, value)) | name == oldname = Field (newname, value)
      rename field = field

modifyField :: (Eq a) => a -> (a -> a) -> Paragraph' a -> Paragraph' a
modifyField name f (Paragraph fields) =
    Paragraph (map modify fields)
    where
      modify (Field (name', value)) | name' == name = Field (name, f value)
      modify field = field

raiseFields :: (Eq a) => (a -> Bool) -> Paragraph' a -> Paragraph' a
-- ^ Move selected fields to the beginning of a paragraph.
raiseFields f (Paragraph fields) =
    let (a, b) = partition f' fields in Paragraph (a ++ b)
    where f' (Field (name, _)) = f name