Cabal.hs

module MicroCabal.Cabal(
  Version(..), makeVersion,
  FieldName, Name,
  Cabal(..),
  Value(..),
  Field(..),
  Cond(..),
  Section(..),
  SectionType,
  VersionRange(..),
  Item,
  FlagInfo(..),
  showCabal, showSection,
  getFieldString,
  getFieldStrings,
  getBuildDepends,
  getBuildDependsPkg,
  getVersion,
  ) where
import Data.Version

--type ExecName = String
type FieldName = String
type Name = String

newtype Cabal = Cabal [Section]
  deriving (Show)

data Value
  = VItems   [Item]
  | VItem    Item
  | VBool    Bool
  | VVersion Version
  | VRange   VersionRange
  | VPkgs    [(Item, [Item], Maybe VersionRange)]
  deriving (Show)

data Field
  = Field FieldName Value
  | If Cond [Field] [Field]
  deriving (Show)

data Cond
  = CBool Bool
  | Cos Item
  | Carch Item
  | Cimpl Item (Maybe VersionRange)
  | Cflag Item
  | Cnot Cond
  | Cand Cond Cond
  | Cor  Cond Cond
  deriving (Show)

data Section = Section SectionType Name [Field]
  deriving (Show)

type SectionType = String

data VersionRange
  = VEQ Version
  | VGT Version
  | VLT Version
  | VLE Version
  | VGE Version
  | VGEHat Version
  | VEQWild Version
  | VOr VersionRange VersionRange
  | VAnd VersionRange VersionRange
  | VEQSet [Version]
  | VGEHatSet [Version]
  deriving (Show)

type Item = String

data FlagInfo = FlagInfo
  { os    :: String
  , arch  :: String
  , impl  :: (String, Version)
  , flags :: [(Name, Bool)]
  }
  deriving (Show)

showCabal :: Cabal -> String
showCabal (Cabal sects) =
  "Cabal\n" ++  unlines (map showSection sects)

showField :: Field -> String
showField (Field n v) = "  Field " ++ n ++ ": " ++ show v
showField (If c t e) =
  "  If " ++ show c ++ "\n" ++
  unlines (map (indent . showField) t) ++
  if null e then "" else
    "  Else\n" ++
    unlines (map (indent . showField) e)

indent :: String -> String
indent s = "  " ++ concatMap (\ c -> if c == '\n' then "\n  " else [c]) s

showSection :: Section -> String
showSection (Section s n fs) = unlines $ ("  " ++ s ++ " " ++ n) : map (indent . showField) fs 

getFieldString :: [Field] -> FieldName -> String
getFieldString flds n =
  case [ s | Field f (VItem s) <- flds, f == n ] of
    [s] -> s
    _   -> error $ "field not found: " ++ show n ++ "\n" ++ unlines (map showField flds)

getFieldStrings :: [Field] -> [String] -> FieldName -> [String]
getFieldStrings flds def n =
  case [ ss | Field f (VItems ss) <- flds, f == n ] of
    [ss] -> ss
    _    -> def

getBuildDepends :: [Field] -> [(Item, [Item], Maybe VersionRange)]
getBuildDepends fs =
  case [ d | Field "build-depends" (VPkgs d) <- fs ] of
    [d] -> d
    _   -> []

getBuildDependsPkg :: [Field] -> [String]
getBuildDependsPkg = map (\ (p,_,_) -> p) . getBuildDepends

getVersion :: [Field] -> String -> Version
getVersion flds n =
  case [ s | Field f (VVersion s) <- flds, f == n ] of
    [s] -> s
    _   -> error $ "field not found: " ++ show n ++ "\n" ++ unlines (map showField flds)