ligo/nix/opam-parser.hs

{-# LANGUAGE FlexibleContexts, LambdaCase, RecordWildCards #-}

import Text.Parsec
import Data.Functor.Identity (Identity ())
import System.Environment (getEnv)
import Data.Maybe (fromJust, isNothing, maybeToList)
import Control.Monad (void)
import Data.List (intersperse, nub, isPrefixOf)
import qualified Control.Applicative as A (optional)

type Package = String

data OPAM
  = OPAM
  { name :: Maybe String
  , version :: Maybe String
  , depends :: Maybe [String]
  , build :: Maybe [[String]]
  , source :: Maybe (String)
  } deriving Show

opam2nix :: OPAM -> String
opam2nix OPAM {..} =
  let depends' = nub ([ "findlib", "ocaml", "opaline", "dune" ]
                      ++ (map (\case 'b':'a':'s':'e':_ -> "base"; s -> s)
                          $ mconcat $ maybeToList depends))
  in
    "{ stdenv, fetchzip, " <> (mconcat $ intersperse ", " depends') <> " }:\n"
  <>"stdenv.mkDerivation rec {\n"
  <>foldMap (\name -> "  pname = \""<>name<>"\";\n") name
  <>foldMap (\version -> "  version = \""<>version<>"\";\n") version
  <>foldMap (\url -> "  src = builtins.fetchTarball { url = \""<>url<>"\"; };\n") source
  <>"  buildInputs = [ "<>(mconcat $ intersperse " " depends')<>" ];\n"
  <>"  propagatedBuildInputs = buildInputs;\n"
  <>foldMap (\build -> "  buildPhase = ''runHook preBuild\n"<>(mconcat $ intersperse " " $ mconcat $ intersperse ["\n"] $ build)<>"\nrunHook postBuild\n'';\n") build
  <>(if "dune" `elem` depends' then "  installPhase = ''\nrunHook preInstall\nopaline -prefix $out -libdir $OCAMLFIND_DESTDIR\nrunHook postInstall\n'';\n" else "")
  <>"}\n"

getSha512 :: [String] -> String
getSha512 cs = (tail.tail.tail.tail.tail.tail.tail) $ head $ filter (isPrefixOf "sha512=") cs

evaluateField :: OPAM -> Field -> OPAM
evaluateField o@(OPAM {..}) = \case
  Name s -> o { name = if isNothing name then Just s else name }
  Version s -> o { version = if isNothing version then Just s else version }
  Depends s -> o { depends = if isNothing depends then Just s else depends }
  Build e -> o { build = if isNothing build then Just (fmap (evaluateExp $ fromJust $ name) <$> e) else build }
  URL url -> o { source = if isNothing source then Just url else source }
  Other _ -> o

evaluateFields :: OPAM -> [Field] -> OPAM
evaluateFields = foldl evaluateField

data Field
  = Name String
  | Version String
  | Depends [Package]
  | Build [[Exp]]
  | URL String
  | Other String
  deriving Show

data Exp = Raw String | NameVar | JobsVar deriving Show

evaluateExp :: String -> Exp -> String
evaluateExp name = \case
  Raw s -> s
  NameVar -> name
  JobsVar -> "1"

opamFile :: ParsecT String u Identity [Field]
opamFile = many field <* eof

field :: ParsecT String u Identity Field
field = Name <$> fieldParser "name" stringParser
    <|> Version <$> fieldParser "version" stringParser
    <|> Depends <$> fieldParser "depends" (listParser packageParser)
    <|> Build <$> fieldParser "build" (pure <$> try commandParser <|> listParser commandParser)
    <|> sectionParser "url" (URL <$> (fieldParser "src" stringParser <* many (noneOf "}")))
    <|> Other <$> ((many (noneOf "\n")) <* char '\n')

fieldParser :: String -> ParsecT String u Identity t -> ParsecT String u Identity t
fieldParser name valueParser = try $ between (string (name<>":") >> (many $ oneOf " \n")) (many $ oneOf " \n") valueParser <* commentParser

sectionParser :: String -> ParsecT String u Identity t -> ParsecT String u Identity t
sectionParser name valueParser = try $ between (string name >> many (oneOf " ") >> string "{" >> many (oneOf " \n")) (many (oneOf " \n") >> char '}' >> char '\n') valueParser

stringParser :: ParsecT String u Identity String
stringParser = between (char '"') (char '"') (many $ noneOf "\"")

expParser :: ParsecT String u Identity Exp
expParser = try (string "name" >> return NameVar)
        <|> try (string "jobs" >> return JobsVar)
        <|> Raw <$> stringParser

commandParser :: ParsecT String u Identity [Exp]
commandParser = do
  command <- listParser expParser
  optional $ try $ between (many (char ' ') >> char '{') (char '}') (many $ noneOf "}")
  return command

commentParser :: ParsecT String u Identity ()
commentParser = optional $ do
  void $ string "#"
  many $ noneOf "\n"

packageParser :: ParsecT String u Identity Package
packageParser = do
  name <- stringParser
  optional $ try $ between (many (char ' ') >> string "{") (char '}') (many $ noneOf "}")
  return name

listParser :: ParsecT String u Identity t -> ParsecT String u Identity [t]
listParser valueParser =
  between (char '[') (char ']') $ between startPadding endPadding
    valueParser `sepBy` sep
  where
    startPadding = sep
    endPadding = optional $ oneOf " \n"
    sep = (whiteSpace >> commentParser) <|> whiteSpace
    whiteSpace = (optional $ many $ oneOf " \n")

main :: IO ()
main = do
  initialOPAM <- OPAM
    <$> A.optional (getEnv "pname")
    <*> A.optional (getEnv "version")
    <*> pure Nothing
    <*> pure Nothing
    <*> pure Nothing

  getContents >>= \s -> case parse opamFile "(unknown)" s of
    Left e -> putStrLn $ show e
    Right fs -> putStrLn $ opam2nix $ evaluateFields initialOPAM fs
    -- Right fs -> print fs