Skip to content

Commit

Permalink
Working Cabal file converter.
Browse files Browse the repository at this point in the history
  • Loading branch information
@alunduil
alunduil committed Sep 7, 2023
1 parent 237f7b3 commit 2ca4186
Show file tree
Hide file tree
Showing 2 changed files with 68 additions and 102 deletions.
112 changes: 47 additions & 65 deletions lib/initialise/Cabal.hs
View file
Original file line number Diff line number Diff line change
@@ -1,26 +1,27 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cabal (replace, convert) where

import Configuration (Configuration (author, licence, name, year))
import Configuration (Configuration (..))
import Control.Exception (Exception)
import Control.Monad.Catch (throwM)
import Control.Monad.Reader (asks, liftIO)
import Data.ByteString (ByteString, readFile)
import Data.ByteString (ByteString, append, breakSubstring, concat, readFile, stripPrefix)
import Data.ByteString.Char8 (pack)
import Data.Text (unpack)
import Data.Text (Text, unpack)
import Data.Text.Encoding (encodeUtf8)
import Distribution.Fields (CommentPosition (NoComment), Field (Field, Section), FieldLine (FieldLine), Name (Name), fromParsecFields, readFields, showFields)
import Distribution.Fields (CommentPosition (NoComment), Field (Field, Section), FieldLine (FieldLine), Name (Name), SectionArg (SecArgName, SecArgStr), fromParsecFields, readFields, showFields)
import Distribution.Fields.Field (fieldLineAnn)
import Distribution.Parsec.Position (Position)
import Distribution.SPDX (licenseId)
import Initialise (Initialise)
import System.Directory.Extra (removeFile)
import System.FilePath (replaceBaseName)
import Text.Parsec.Error (ParseError)
import Prelude hiding (readFile)
import Prelude hiding (concat, readFile)

instance Exception ParseError

Expand All @@ -42,68 +43,49 @@ convert contents = do

convert' :: Field Position -> Initialise (Field Position)
convert' f@(Field n@(Name _ fName) ls) = do
name' <- asks name
licence' <- asks licence
author' <- asks author
year' <- asks year
let annotation = fieldLineAnn . head $ ls
Configuration {..} <- asks id
case fName of
"name" -> pure $ Field n [FieldLine annotation (encodeUtf8 name')]
"version" -> pure $ Field n [FieldLine annotation "0.1.0.0"]
"license" -> pure $ Field n [FieldLine annotation (pack $ licenseId licence')]
"copyright" -> pure $ Field n [FieldLine annotation (unwords ["(c)", author', show year'])]
-- package
"name" -> field (encodeUtf8 name)
"version" -> field "0.1.0.0"
"license" -> field (pack $ licenseId licence)
"copyright" -> field (pack $ unwords ["(c)", show year, unpack author])
"author" -> field (encodeUtf8 author)
"maintainer" -> field (encodeUtf8 maintainer)
"homepage" -> field $ pack $ show homepage
"bug-reports" -> field $ pack (show homepage ++ "/issues")
"synopsis" -> field "TODO"
"description" -> field "TODO"
-- common
"import" -> field (encodeUtf8 name `append` "-common")
"exposed-modules" -> field ""
"other-modules" -> field ""
"build-depends" -> pure $ Field n $ map (convertFieldLine name) ls
"hs-source-dirs" -> pure $ Field n $ map (convertFieldLine name) ls
-- source-repository
"location" -> field $ pack $ show homepage
_ -> pure f
convert' f@(Section n@(Name _ fName) arguments ls) = undefined
where
field s = pure $ Field n [FieldLine annotation s]
annotation = fieldLineAnn . head $ ls
convert' (Section n arguments fs) = do
Configuration {..} <- asks id
fs' <- mapM convert' fs
pure $ Section n (map (convertSectionArgument name) arguments) fs'

{-
instance ModifyWith PD.PackageDescription where
modifyWith metadata pd =
pd
{ PD.package = modifyWith metadata pd.package,
PD.licenseRaw = Left . License . simpleLicenseExpression $ metadata.licence,
PD.copyright = toShortText $ unwords ["(c)", show metadata.year, metadata.author],
PD.maintainer = toShortText metadata.maintainer,
PD.author = toShortText metadata.author,
PD.homepage = toShortText $ show metadata.homepage,
PD.bugReports = toShortText $ show metadata.homepage ++ "/issues",
PD.sourceRepos =
[ (emptySourceRepo RepoHead)
{ repoType = Just $ KnownRepoType Git,
repoLocation = Just $ show metadata.homepage
}
],
PD.executables = modifyWith metadata <$> pd.executables,
PD.testSuites = modifyWith metadata <$> pd.testSuites
}
convertSectionArgument :: Text -> SectionArg Position -> SectionArg Position
convertSectionArgument n s = case s of
(SecArgName a o) -> SecArgName a $ convertString n o
(SecArgStr a o) -> SecArgStr a $ convertString n o
_ -> s

instance ModifyWith PackageIdentifier where
modifyWith metadata _pi =
PackageIdentifier
{ pkgName = mkPackageName $ name metadata,
pkgVersion = mkVersion [0, 1, 0, 0]
}
convertFieldLine :: Text -> FieldLine Position -> FieldLine Position
convertFieldLine r (FieldLine annotation s) = FieldLine annotation $ convertString r s

instance ModifyWith Executable where
modifyWith metadata executable =
executable
{ exeName = mkUnqualComponentName metadata.name,
buildInfo = modifyWith metadata executable.buildInfo
}
instance ModifyWith TestSuite where
modifyWith metadata testSuite =
testSuite
{ testName = mkUnqualComponentName $ metadata.name ++ "-test",
testBuildInfo = modifyWith metadata testSuite.testBuildInfo
}
instance ModifyWith BuildInfo where
modifyWith metadata buildInfo =
buildInfo
{ otherModules = [],
targetBuildDepends = filter is_base buildInfo.targetBuildDepends
}
where
is_base = ("base" ==) . unPackageName . depPkgName
-}
convertString :: Text -> ByteString -> ByteString
convertString r s = case token `stripPrefix` rest of
Just suffix -> concat [prefix, encodeUtf8 r, suffix]
Nothing -> s
where
(prefix, rest) = token `breakSubstring` s
token = "initialise"
58 changes: 21 additions & 37 deletions test/initialise/data/templatise-20230829.golden.cabal
View file
Original file line number Diff line number Diff line change
@@ -1,21 +1,16 @@
cabal-version: 3.0
name: templatise
name: sentinel
version: 0.1.0.0
license: Unlicense
license: MIT
license-file: LICENSE
copyright: (c) 2023 Alex Brandt
author: Alex Brandt
maintainer: alunduil@gmail.com
copyright: (c) 1970 Sentinel
author: Sentinel
maintainer: sentinel@example.com
stability: alpha
homepage: https://github.com/alunduil/template.hs
bug-reports: https://github.com/alunduil/template.hs/issues
synopsis:
You can use template.hs to create a new Haskell GitHub repository.

description:
You can use template.hs to create a new GitHub repository. The repository will
have Haskell, VS Code devcontainers, and various GitHub actions ready to use.

homepage: https://github.com/sentinel/sentinel.git
bug-reports: https://github.com/sentinel/sentinel.git/issues
synopsis: TODO
description: TODO
category: VSCode
tested-with: GHC ==9.2.8 || ==9.4.5 || ==9.6.2
extra-source-files:
Expand All @@ -24,9 +19,9 @@ extra-source-files:

source-repository head
type: git
location: https://github.com/alunduil/template.hs
location: https://github.com/sentinel/sentinel.git

common initialise-common
common sentinel-common
build-depends:
, base ^>=4.16.4.0 || ^>=4.17.0.0 || ^>=4.18.0.0
, bytestring ^>=0.11.4.0 || ^>=0.12.0.2
Expand All @@ -37,55 +32,44 @@ common initialise-common
, optparse-applicative ^>=0.18.1.0
, text ^>=2.0.2

library initialise-library
import: initialise-common
library sentinel-library
import: sentinel-common
exposed-modules:
Cabal
Configuration
Defaults
Git
Initialise

build-depends:
, exceptions ^>=0.10.5
, extra ^>=1.7.14
, parsec ^>=3.1.16.1
, process ^>=1.6.16.0
, time ^>=1.11.1.1 || ^>=1.12.2

hs-source-dirs: lib/initialise
hs-source-dirs: lib/sentinel
default-language: Haskell2010
ghc-options: -Wall

test-suite initialise-test
import: initialise-common
test-suite sentinel-test
import: sentinel-common
type: exitcode-stdio-1.0
main-is: Main.hs
build-depends:
, hspec ^>=2.11.4
, initialise-library
, sentinel-library
, tasty ^>=1.4.3
, tasty-golden ^>=2.3.5
, tasty-hspec ^>=1.2.0.4

other-modules:
CabalGolden
ConfigurationSpec
DefaultsSpec
GitSpec

hs-source-dirs: test/initialise
hs-source-dirs: test/sentinel
default-language: Haskell2010
ghc-options: -threaded -Wall

executable initialise
executable sentinel
main-is: Main.hs
build-depends:
, base ^>=4.16.4.0 || ^>=4.17.0.0 || ^>=4.18.0.0
, http-client ^>=0.7.13.1
, http-conduit ^>=2.3.8.3
, initialise-library
, sentinel-library

hs-source-dirs: bin/initialise
hs-source-dirs: bin/sentinel
default-language: Haskell2010
ghc-options: -threaded -Wall

0 comments on commit 2ca4186

Please sign in to comment.