module CabalGild.Extra.ModuleName where

import qualified CabalGild.Extra.String as String
import qualified Data.List as List
import qualified Distribution.Fields as Fields
import qualified Distribution.ModuleName as ModuleName
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified System.FilePath as FilePath

fromFilePath :: FilePath -> Maybe ModuleName.ModuleName
fromFilePath :: FilePath -> Maybe ModuleName
fromFilePath = FilePath -> Maybe ModuleName
forall a. Parsec a => FilePath -> Maybe a
Parsec.simpleParsec (FilePath -> Maybe ModuleName)
-> (FilePath -> FilePath) -> FilePath -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"." ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
FilePath.splitDirectories

toFieldLine :: a -> ModuleName.ModuleName -> Fields.FieldLine a
toFieldLine :: forall a. a -> ModuleName -> FieldLine a
toFieldLine a
a = a -> ByteString -> FieldLine a
forall ann. ann -> ByteString -> FieldLine ann
Fields.FieldLine a
a (ByteString -> FieldLine a)
-> (ModuleName -> ByteString) -> ModuleName -> FieldLine a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
String.toUtf8 (FilePath -> ByteString)
-> (ModuleName -> FilePath) -> ModuleName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
Pretty.prettyShow