diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.5.1. +-- This file has been generated from package.yaml by hpack version 0.5.2. -- -- see: https://github.com/sol/hpack name: hpack -version: 0.5.2 +version: 0.5.3 synopsis: An alternative format for Haskell packages homepage: https://github.com/sol/hpack#readme bug-reports: https://github.com/sol/hpack/issues @@ -36,6 +36,8 @@ Hpack.Config Hpack.Run other-modules: + Hpack.GenericsUtil + Hpack.Haskell Hpack.Render Hpack.Util default-language: Haskell2010 @@ -84,10 +86,14 @@ other-modules: Helper Hpack.ConfigSpec + Hpack.GenericsUtilSpec + Hpack.HaskellSpec Hpack.RenderSpec Hpack.RunSpec Hpack.UtilSpec Hpack.Config + Hpack.GenericsUtil + Hpack.Haskell Hpack.Render Hpack.Run Hpack.Util diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -1,14 +1,12 @@ {-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} module Hpack.Config ( packageConfig , readPackageConfig @@ -21,6 +19,9 @@ , Library(..) , Executable(..) , SourceRepository(..) + +-- exported for testing +, getModules ) where import Control.Applicative @@ -43,6 +44,7 @@ import System.FilePath import Hpack.Util +import Hpack.GenericsUtil packageConfig :: FilePath packageConfig = "package.yaml" @@ -50,26 +52,25 @@ githubBaseUrl :: String githubBaseUrl = "https://github.com/" -genericParseJSON_ :: forall a. (Typeable a, Generic a, GFromJSON (Rep a)) => Value -> Parser a +genericParseJSON_ :: forall a. (Generic a, GFromJSON (Rep a), HasTypeName a) => Value -> Parser a genericParseJSON_ = genericParseJSON defaultOptions {fieldLabelModifier = hyphenize name} where - name = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) + name :: String + name = typeName (Proxy :: Proxy a) hyphenize :: String -> String -> String hyphenize name = camelTo '-' . drop (length name) class HasFieldNames a where - fieldNames :: a -> [String] - default fieldNames :: Data a => a -> [String] - fieldNames a = map (hyphenize name) (constrFields constr) - where - constr = toConstr a - name = showConstr constr + fieldNames :: Proxy a -> [String] + default fieldNames :: (HasTypeName a, Generic a, Selectors (Rep a)) => Proxy a -> [String] + fieldNames proxy = map (hyphenize $ typeName proxy) (selectors proxy) + data CaptureUnknownFields a = CaptureUnknownFields { captureUnknownFieldsFields :: [String] , captureUnknownFieldsValue :: a -} deriving (Eq, Show, Generic, Data, Typeable) +} deriving (Eq, Show, Generic) instance (HasFieldNames a, FromJSON a) => FromJSON (CaptureUnknownFields a) where parseJSON v = captureUnknownFields <$> parseJSON v @@ -79,13 +80,13 @@ where unknown = keys \\ fields keys = map T.unpack (Map.keys o) - fields = fieldNames a + fields = fieldNames (Proxy :: Proxy a) _ -> CaptureUnknownFields [] a data LibrarySection = LibrarySection { librarySectionExposedModules :: Maybe (List String) , librarySectionOtherModules :: Maybe (List String) -} deriving (Eq, Show, Generic, Data, Typeable) +} deriving (Eq, Show, Generic) instance HasFieldNames LibrarySection @@ -95,7 +96,7 @@ data ExecutableSection = ExecutableSection { executableSectionMain :: FilePath , executableSectionOtherModules :: Maybe (List String) -} deriving (Eq, Show, Generic, Data, Typeable) +} deriving (Eq, Show, Generic) instance HasFieldNames ExecutableSection @@ -108,7 +109,7 @@ , commonOptionsDefaultExtensions :: Maybe (List String) , commonOptionsGhcOptions :: Maybe (List GhcOption) , commonOptionsCppOptions :: Maybe (List CppOption) -} deriving (Eq, Show, Generic, Data, Typeable) +} deriving (Eq, Show, Generic) instance HasFieldNames CommonOptions @@ -134,7 +135,7 @@ , packageConfigLibrary :: Maybe (CaptureUnknownFields (Section LibrarySection)) , packageConfigExecutables :: Maybe (HashMap String (CaptureUnknownFields (Section ExecutableSection))) , packageConfigTests :: Maybe (HashMap String (CaptureUnknownFields (Section ExecutableSection))) -} deriving (Eq, Show, Generic, Data, Typeable) +} deriving (Eq, Show, Generic) instance HasFieldNames PackageConfig @@ -179,7 +180,7 @@ data Dependency = Dependency { dependencyName :: String , dependencyGitRef :: Maybe GitRef -} deriving (Eq, Show, Ord, Generic, Data, Typeable) +} deriving (Eq, Show, Ord, Generic) instance IsString Dependency where fromString name = Dependency name Nothing @@ -210,9 +211,8 @@ data GitRef = GitRef { gitRefUrl :: String , gitRefRef :: String -} deriving (Eq, Show, Ord, Generic, Data, Typeable) +} deriving (Eq, Show, Ord, Generic) -type GhcOption = String type CppOption = String data Package = Package { @@ -255,13 +255,10 @@ , sectionDefaultExtensions :: [String] , sectionGhcOptions :: [GhcOption] , sectionCppOptions :: [CppOption] -} deriving (Eq, Show, Functor, Foldable, Traversable, Data, Typeable) +} deriving (Eq, Show, Functor, Foldable, Traversable) instance HasFieldNames a => HasFieldNames (Section a) where - fieldNames section = (fieldNames (sectionData section) ++ fieldNames proxy) - where - proxy :: CommonOptions - proxy = CommonOptions Nothing Nothing Nothing Nothing Nothing + fieldNames Proxy = fieldNames (Proxy :: Proxy a) ++ fieldNames (Proxy :: Proxy CommonOptions) instance FromJSON a => FromJSON (Section a) where parseJSON v = toSection <$> parseJSON v <*> parseJSON v @@ -398,19 +395,20 @@ sections = map (fmap $ mergeSections globalOptions) executables toExecutable :: (String, Section ExecutableSection) -> IO (Section Executable) - toExecutable (name, section) = traverse fromExecutableSection section + toExecutable (name, section@Section{..}) = do + (executable, ghcOptions) <- fromExecutableSection sectionData + return (section {sectionData = executable, sectionGhcOptions = sectionGhcOptions ++ ghcOptions}) where - sourceDirs :: [FilePath] - sourceDirs = sectionSourceDirs section - - fromExecutableSection :: ExecutableSection -> IO Executable + fromExecutableSection :: ExecutableSection -> IO (Executable, [GhcOption]) fromExecutableSection ExecutableSection{..} = do - modules <- maybe (filterMain . concat <$> mapM getModules sourceDirs) (return . fromList) executableSectionOtherModules - return (Executable name executableSectionMain modules) + modules <- maybe (filterMain . concat <$> mapM getModules sectionSourceDirs) (return . fromList) executableSectionOtherModules + return (Executable name mainSrcFile modules, ghcOptions) where filterMain :: [String] -> [String] filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain) + (mainSrcFile, ghcOptions) = parseMain executableSectionMain + mergeSections :: Section global -> Section a -> Section a mergeSections globalOptions options = Section a sourceDirs dependencies defaultExtensions ghcOptions cppOptions @@ -441,14 +439,22 @@ exposedModules = maybe (modules \\ otherModules) fromList mExposedModules getModules :: FilePath -> IO [String] -getModules src = sort <$> do - exits <- doesDirectoryExist src - if exits - then toModules <$> getFilesRecursive src +getModules src_ = sort <$> do + exists <- doesDirectoryExist src_ + if exists + then do + src <- canonicalizePath src_ + cwd <- getCurrentDirectory + removeSetup cwd src . toModules <$> getFilesRecursive src else return [] where toModules :: [[FilePath]] -> [String] toModules = catMaybes . map toModule + + removeSetup :: FilePath -> FilePath -> [String] -> [String] + removeSetup cwd src + | src == cwd = filter (/= "Setup") + | otherwise = id fromMaybeList :: Maybe (List a) -> [a] fromMaybeList = maybe [] fromList diff --git a/src/Hpack/GenericsUtil.hs b/src/Hpack/GenericsUtil.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/GenericsUtil.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module Hpack.GenericsUtil ( + HasTypeName +, typeName +, Selectors +, selectors +) where + +import Data.Proxy +import GHC.Generics + +class HasTypeName a where + typeName :: Proxy a -> String + +instance (Datatype d, Generic a, Rep a ~ M1 D d m) => HasTypeName a where + typeName _ = datatypeName (undefined :: M1 D d x y) + +selectors :: (Generic a, Selectors (Rep a)) => Proxy a -> [String] +selectors = f + where + f :: forall a. (Generic a, Selectors (Rep a)) => Proxy a -> [String] + f _ = selNames (Proxy :: Proxy (Rep a)) + +class Selectors a where + selNames :: Proxy a -> [String] + +instance Selectors f => Selectors (M1 D x f) where + selNames _ = selNames (Proxy :: Proxy f) + +instance Selectors f => Selectors (M1 C x f) where + selNames _ = selNames (Proxy :: Proxy f) + +instance Selector s => Selectors (M1 S s (K1 R t)) where + selNames _ = [selName (undefined :: M1 S s (K1 R t) ())] + +instance (Selectors a, Selectors b) => Selectors (a :*: b) where + selNames _ = selNames (Proxy :: Proxy a) ++ selNames (Proxy :: Proxy b) + +instance Selectors U1 where + selNames _ = [] diff --git a/src/Hpack/Haskell.hs b/src/Hpack/Haskell.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/Haskell.hs @@ -0,0 +1,55 @@ +module Hpack.Haskell ( + isModule +, isQualifiedIdentifier +, isIdentifier +) where + +import Data.Char + +isModule :: [String] -> Bool +isModule name = (not . null) name && all isModuleName name + +isModuleName :: String -> Bool +isModuleName name = case name of + x : xs -> isUpper x && all isIdChar xs + _ -> False + +isQualifiedIdentifier :: [String] -> Bool +isQualifiedIdentifier name = case reverse name of + x : xs -> isIdentifier x && isModule xs + _ -> False + +isIdentifier :: String -> Bool +isIdentifier name = case name of + x : xs -> isLower x && all isIdChar xs && name `notElem` reserved + _ -> False + +reserved :: [String] +reserved = [ + "case" + , "class" + , "data" + , "default" + , "deriving" + , "do" + , "else" + , "foreign" + , "if" + , "import" + , "in" + , "infix" + , "infixl" + , "infixr" + , "instance" + , "let" + , "module" + , "newtype" + , "of" + , "then" + , "type" + , "where" + , "_" + ] + +isIdChar :: Char -> Bool +isIdChar c = isAlphaNum c || c == '_' || c == '\'' diff --git a/src/Hpack/Render.hs b/src/Hpack/Render.hs --- a/src/Hpack/Render.hs +++ b/src/Hpack/Render.hs @@ -18,10 +18,7 @@ | WordList [String] deriving (Eq, Show) -data Field = Field String Value - deriving (Eq, Show) - -data Stanza = Stanza String [Field] | Fields [Field] +data Element = Stanza String [Element] | Field String Value deriving (Eq, Show) data Lines = SingleLine String | MultipleLines [String] @@ -38,22 +35,16 @@ defaultRenderSettings :: RenderSettings defaultRenderSettings = RenderSettings 2 LeadingCommas -class Render a where - render :: RenderSettings -> Int -> a -> [String] - -instance Render Stanza where - render settings nesting (Fields fields) = concatMap (render settings nesting) fields - render settings nesting (Stanza name fields) = name : renderFields fields - where - renderFields :: [Field] -> [String] - renderFields = concatMap (render settings $ succ nesting) - -instance Render Field where - render settings nesting (Field name v) = case renderValue settings v of - SingleLine "" -> [] - SingleLine x -> [indent settings nesting (name ++ ": " ++ x)] - MultipleLines [] -> [] - MultipleLines xs -> (indent settings nesting name ++ ":") : map (indent settings $ succ nesting) xs +render :: RenderSettings -> Int -> Element -> [String] +render settings nesting (Stanza name elements) = indent settings nesting name : renderElements elements + where + renderElements :: [Element] -> [String] + renderElements = concatMap (render settings $ succ nesting) +render settings nesting (Field name v) = case renderValue settings v of + SingleLine "" -> [] + SingleLine x -> [indent settings nesting (name ++ ": " ++ x)] + MultipleLines [] -> [] + MultipleLines xs -> (indent settings nesting name ++ ":") : map (indent settings $ succ nesting) xs renderValue :: RenderSettings -> Value -> Lines renderValue RenderSettings{..} v = case v of diff --git a/src/Hpack/Run.hs b/src/Hpack/Run.hs --- a/src/Hpack/Run.hs +++ b/src/Hpack/Run.hs @@ -46,18 +46,18 @@ header = unlines $ map formatField sortedFields - extraSourceFiles :: Field + extraSourceFiles :: Element extraSourceFiles = Field "extra-source-files" (LineSeparatedList packageExtraSourceFiles) - dataFiles :: Field + dataFiles :: Element dataFiles = Field "data-files" (LineSeparatedList packageDataFiles) sourceRepository = maybe [] (return . renderSourceRepository) packageSourceRepository library = maybe [] (return . renderLibrary) packageLibrary - stanzas :: [Stanza] - stanzas = Fields [extraSourceFiles] : Fields [dataFiles] : sourceRepository ++ library ++ renderExecutables packageExecutables ++ renderTests packageTests + stanzas :: [Element] + stanzas = extraSourceFiles : dataFiles : sourceRepository ++ library ++ renderExecutables packageExecutables ++ renderTests packageTests padding name = replicate (alignment - length name - 2) ' ' @@ -124,36 +124,36 @@ isEmptyLine = all isSpace -renderSourceRepository :: SourceRepository -> Stanza +renderSourceRepository :: SourceRepository -> Element renderSourceRepository SourceRepository{..} = Stanza "source-repository head" [ Field "type" "git" , Field "location" (Literal sourceRepositoryUrl) , Field "subdir" (maybe "" Literal sourceRepositorySubdir) ] -renderExecutables :: [Section Executable] -> [Stanza] +renderExecutables :: [Section Executable] -> [Element] renderExecutables = map renderExecutable -renderExecutable :: Section Executable -> Stanza +renderExecutable :: Section Executable -> Element renderExecutable section@(sectionData -> Executable{..}) = Stanza ("executable " ++ executableName) (renderExecutableSection section) -renderTests :: [Section Executable] -> [Stanza] +renderTests :: [Section Executable] -> [Element] renderTests = map renderTest -renderTest :: Section Executable -> Stanza +renderTest :: Section Executable -> Element renderTest section@(sectionData -> Executable{..}) = Stanza ("test-suite " ++ executableName) (Field "type" "exitcode-stdio-1.0" : renderExecutableSection section) -renderExecutableSection :: Section Executable -> [Field] +renderExecutableSection :: Section Executable -> [Element] renderExecutableSection section@(sectionData -> Executable{..}) = mainIs : renderSection section ++ [otherModules, defaultLanguage] where mainIs = Field "main-is" (Literal executableMain) otherModules = renderOtherModules executableOtherModules -renderLibrary :: Section Library -> Stanza +renderLibrary :: Section Library -> Element renderLibrary section@(sectionData -> Library{..}) = Stanza "library" $ renderSection section ++ [ renderExposedModules libraryExposedModules @@ -161,7 +161,7 @@ , defaultLanguage ] -renderSection :: Section a -> [Field] +renderSection :: Section a -> [Element] renderSection Section{..} = [ renderSourceDirs sectionSourceDirs , renderDefaultExtensions sectionDefaultExtensions @@ -170,26 +170,26 @@ , renderDependencies sectionDependencies ] -defaultLanguage :: Field +defaultLanguage :: Element defaultLanguage = Field "default-language" "Haskell2010" -renderSourceDirs :: [String] -> Field +renderSourceDirs :: [String] -> Element renderSourceDirs dirs = Field "hs-source-dirs" (CommaSeparatedList dirs) -renderExposedModules :: [String] -> Field +renderExposedModules :: [String] -> Element renderExposedModules modules = Field "exposed-modules" (LineSeparatedList modules) -renderOtherModules :: [String] -> Field +renderOtherModules :: [String] -> Element renderOtherModules modules = Field "other-modules" (LineSeparatedList modules) -renderDependencies :: [Dependency] -> Field +renderDependencies :: [Dependency] -> Element renderDependencies dependencies = Field "build-depends" (CommaSeparatedList $ map dependencyName dependencies) -renderGhcOptions :: [GhcOption] -> Field +renderGhcOptions :: [GhcOption] -> Element renderGhcOptions = Field "ghc-options" . WordList -renderCppOptions :: [GhcOption] -> Field +renderCppOptions :: [GhcOption] -> Element renderCppOptions = Field "cpp-options" . WordList -renderDefaultExtensions :: [String] -> Field +renderDefaultExtensions :: [String] -> Element renderDefaultExtensions = Field "default-extensions" . WordList diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} module Hpack.Util ( List(..) +, GhcOption +, parseMain , toModule , getFilesRecursive , tryReadFile @@ -28,6 +30,8 @@ import System.FilePath import System.FilePath.Glob +import Hpack.Haskell + sort :: [String] -> [String] sort = sortBy (comparing lexicographically) @@ -40,24 +44,33 @@ instance FromJSON a => FromJSON (List a) where parseJSON v = List <$> (parseJSON v <|> (return <$> parseJSON v)) +type GhcOption = String + +parseMain :: String -> (FilePath, [GhcOption]) +parseMain main = case reverse name of + x : _ | isQualifiedIdentifier name && x `notElem` ["hs", "lhs"] -> (intercalate "/" (init name) ++ ".hs", ["-main-is " ++ main]) + _ | isModule name -> (intercalate "/" name ++ ".hs", ["-main-is " ++ main]) + _ -> (main, []) + where + name = splitOn '.' main + +splitOn :: Char -> String -> [String] +splitOn c = go + where + go xs = case break (== c) xs of + (ys, "") -> [ys] + (ys, _:zs) -> ys : go zs + toModule :: [FilePath] -> Maybe String toModule path = case reverse path of [] -> Nothing x : xs -> do m <- stripSuffix ".hs" x <|> stripSuffix ".lhs" x let name = reverse (m : xs) - guard (all isValidModuleName name) >> return (intercalate "." name) + guard (isModule name) >> return (intercalate "." name) where stripSuffix :: String -> String -> Maybe String stripSuffix suffix x = reverse <$> stripPrefix (reverse suffix) (reverse x) - --- See `Cabal.Distribution.ModuleName` (http://git.io/bj34) -isValidModuleName :: String -> Bool -isValidModuleName [] = False -isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs - -isValidModuleChar :: Char -> Bool -isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' getFilesRecursive :: FilePath -> IO [[String]] getFilesRecursive baseDir = go [] diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -78,6 +78,25 @@ }|] parseEither parseJSON value `shouldBe` (Left "neither key \"git\" nor key \"github\" present" :: Either String Dependency) + describe "getModules" $ around_ inTempDirectory $ do + it "returns Haskell modules in specified source directory" $ do + touch "src/Foo.hs" + touch "src/Bar/Baz.hs" + touch "src/Setup.hs" + getModules "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"]) + + context "when source directory is '.'" $ do + it "ignores Setup" $ do + touch "Foo.hs" + touch "Setup.hs" + getModules "." `shouldReturn` ["Foo"] + + context "when source directory is './.'" $ do + it "ignores Setup" $ do + touch "Foo.hs" + touch "Setup.hs" + getModules "./." `shouldReturn` ["Foo"] + describe "readPackageConfig" $ around_ (inTempDirectoryNamed "foo") $ do it "warns on unknown fields" $ do writeFile "package.yaml" [i| @@ -394,6 +413,17 @@ |] Right (_, c) <- readPackageConfig "package.yaml" packageExecutables c `shouldBe` [section $ executable "foo" "driver/Main.hs"] + + it "accepts arbitrary entry points as main" $ do + writeFile "package.yaml" [i| + executables: + foo: + main: Foo + |] + Right (_, c) <- readPackageConfig "package.yaml" + packageExecutables c `shouldBe` [ + (section $ executable "foo" "Foo.hs") {sectionGhcOptions = ["-main-is Foo"]} + ] it "accepts source-dirs" $ do writeFile "package.yaml" [i| diff --git a/test/Hpack/GenericsUtilSpec.hs b/test/Hpack/GenericsUtilSpec.hs new file mode 100644 --- /dev/null +++ b/test/Hpack/GenericsUtilSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DeriveGeneric #-} +module Hpack.GenericsUtilSpec (spec) where + +import Test.Hspec + +import Data.Proxy +import GHC.Generics + +import Hpack.GenericsUtil + +data Person = Person { + _personName :: String +, _personAge :: Int +} deriving Generic + +spec :: Spec +spec = do + describe "selectors" $ do + it "returns a list of record selectors" $ do + selectors (Proxy :: Proxy Person) `shouldBe` ["_personName", "_personAge"] + + describe "typeName" $ do + it "gets datatype name" $ do + typeName (Proxy :: Proxy Person) `shouldBe` "Person" diff --git a/test/Hpack/HaskellSpec.hs b/test/Hpack/HaskellSpec.hs new file mode 100644 --- /dev/null +++ b/test/Hpack/HaskellSpec.hs @@ -0,0 +1,31 @@ +module Hpack.HaskellSpec (spec) where + +import Test.Hspec + +import Hpack.Haskell + +spec :: Spec +spec = do + describe "isModule" $ do + it "accepts module names" $ do + isModule ["Foo", "Bar"] `shouldBe` True + + it "rejects the empty list" $ do + isModule [] `shouldBe` False + + describe "isQualifiedIdentifier" $ do + it "accepts qualified Haskell identifiers" $ do + isQualifiedIdentifier ["Foo", "Bar", "baz"] `shouldBe` True + + it "rejects invalid input" $ do + isQualifiedIdentifier ["Foo", "Bar", "Baz"] `shouldBe` False + + describe "isIdentifier" $ do + it "accepts Haskell identifiers" $ do + isIdentifier "foo" `shouldBe` True + + it "rejects reserved keywords" $ do + isIdentifier "case" `shouldBe` False + + it "rejects invalid input" $ do + isIdentifier "Foo" `shouldBe` False diff --git a/test/Hpack/RenderSpec.hs b/test/Hpack/RenderSpec.hs --- a/test/Hpack/RenderSpec.hs +++ b/test/Hpack/RenderSpec.hs @@ -42,6 +42,15 @@ , " baz: 42" ] + it "renders nested stanzas" $ do + let input = Stanza "foo" [Field "bar" "23", Stanza "baz" [Field "qux" "42"]] + render defaultRenderSettings 0 input `shouldBe` [ + "foo" + , " bar: 23" + , " baz" + , " qux: 42" + ] + context "when rendering a Field" $ do context "when rendering a MultipleLines value" $ do it "takes nesting into account" $ do diff --git a/test/Hpack/UtilSpec.hs b/test/Hpack/UtilSpec.hs --- a/test/Hpack/UtilSpec.hs +++ b/test/Hpack/UtilSpec.hs @@ -16,6 +16,22 @@ it "sorts lexicographically" $ do sort ["foo", "Foo"] `shouldBe` ["Foo", "foo" :: String] + describe "parseMain" $ do + it "accepts source file" $ do + parseMain "Main.hs" `shouldBe` ("Main.hs", []) + + it "accepts literate source file" $ do + parseMain "Main.lhs" `shouldBe` ("Main.lhs", []) + + it "accepts module" $ do + parseMain "Foo" `shouldBe` ("Foo.hs", ["-main-is Foo"]) + + it "accepts hierarchical module" $ do + parseMain "Foo.Bar.Baz" `shouldBe` ("Foo/Bar/Baz.hs", ["-main-is Foo.Bar.Baz"]) + + it "accepts qualified identifier" $ do + parseMain "Foo.bar" `shouldBe` ("Foo.hs", ["-main-is Foo.bar"]) + describe "toModule" $ do it "maps paths to module names" $ do toModule ["Foo", "Bar", "Baz.hs"] `shouldBe` Just "Foo.Bar.Baz"