module ModuleMunging
  ( Module(..)
  , ModuleName(..)
  , buildModule
  , displayModule
  , ModuleFragment(..)
  , ModuleExport(..)
  , ModuleImport(..)
  , ModuleImportStyle(..)
  , ModuleDeclaration(..)
  , DeclName(..)
  , DeclBody(..)
  ) where

import Prelude

import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Kind (Type)
import Data.String (IsString)
import Text.Printf (printf)

import Data.Char qualified as Char
import Data.List qualified as List
import Data.Maybe qualified as Maybe

type Module :: Type
data Module = Module
  { Module -> String
moduleName :: String
  , Module -> [String]
moduleExports :: [String]
  , Module -> [ModuleImport]
moduleImports :: [ModuleImport]
  , Module -> [ModuleDeclaration]
moduleDeclarations :: [ModuleDeclaration]
  } deriving stock (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
/= :: Module -> Module -> Bool
Eq, Int -> Module -> String -> String
[Module] -> String -> String
Module -> String
(Int -> Module -> String -> String)
-> (Module -> String)
-> ([Module] -> String -> String)
-> Show Module
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Module -> String -> String
showsPrec :: Int -> Module -> String -> String
$cshow :: Module -> String
show :: Module -> String
$cshowList :: [Module] -> String -> String
showList :: [Module] -> String -> String
Show)

type ModuleName :: Type
data ModuleName
  = ModuleNameExact String
  | ModuleNameFromFilePath FilePath

moduleNameFromFilePath :: FilePath -> Maybe String
moduleNameFromFilePath :: String -> Maybe String
moduleNameFromFilePath String
fp = do
  String
fp' <- String -> String
forall a. [a] -> [a]
List.reverse (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"sh." (String -> String
forall a. [a] -> [a]
List.reverse String
fp)
  String
n : [String]
_ <- [String] -> Maybe [String]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isUpper (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
head) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. [a] -> [[a]]
List.tails String
fp'
  String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
n String -> (String -> String) -> String
forall a b. a -> (a -> b) -> b
& (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map \case
    Char
c | Char -> Bool
Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' -> Char
c
      | Bool
otherwise -> Char
'.'

buildModule :: ModuleName -> ModuleFragment -> Module
buildModule :: ModuleName -> ModuleFragment -> Module
buildModule ModuleName
name ModuleFragment
modFragment =
  Module
    { moduleName :: String
moduleName =
        case ModuleName
name of
          ModuleNameExact String
n -> String
n
          ModuleNameFromFilePath String
fp
            | Just String
n <- String -> Maybe String
moduleNameFromFilePath String
fp -> String
n
            | Bool
otherwise -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"buildModule: Failed to convert filepath \"%s\" to module" String
fp
    , moduleExports :: [String]
moduleExports = [ModuleDeclaration] -> [String]
toExports ([ModuleDeclaration] -> [String])
-> [ModuleDeclaration] -> [String]
forall a b. (a -> b) -> a -> b
$ ModuleFragment -> [ModuleDeclaration]
moduleFragmentDeclarations ModuleFragment
modFragment
    , moduleImports :: [ModuleImport]
moduleImports =
        [[ModuleImport]] -> [ModuleImport]
flattenModuleImportGroups
          ([[ModuleImport]] -> [ModuleImport])
-> [[ModuleImport]] -> [ModuleImport]
forall a b. (a -> b) -> a -> b
$ (ModuleImport -> ModuleImport -> Bool)
-> [ModuleImport] -> [[ModuleImport]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy ModuleImport -> ModuleImport -> Bool
groupModuleImports
          ([ModuleImport] -> [[ModuleImport]])
-> [ModuleImport] -> [[ModuleImport]]
forall a b. (a -> b) -> a -> b
$ [ModuleImport] -> [ModuleImport]
forall a. Ord a => [a] -> [a]
List.sort
          ([ModuleImport] -> [ModuleImport])
-> [ModuleImport] -> [ModuleImport]
forall a b. (a -> b) -> a -> b
$ ModuleFragment -> [ModuleImport]
moduleFragmentImports ModuleFragment
modFragment
    , moduleDeclarations :: [ModuleDeclaration]
moduleDeclarations = ModuleFragment -> [ModuleDeclaration]
moduleFragmentDeclarations ModuleFragment
modFragment
    }
  where
  toExports :: [ModuleDeclaration] -> [String]
  toExports :: [ModuleDeclaration] -> [String]
toExports = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> ([ModuleDeclaration] -> [String])
-> [ModuleDeclaration]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleDeclaration -> String) -> [ModuleDeclaration] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
    ModuleDeclaration Bool
shouldExport (DeclName String
funName) DeclBody
_
      | Bool
shouldExport -> String
funName
      | Bool
otherwise -> []

  flattenModuleImportGroups :: [[ModuleImport]] -> [ModuleImport]
  flattenModuleImportGroups :: [[ModuleImport]] -> [ModuleImport]
flattenModuleImportGroups = ([ModuleImport] -> [ModuleImport])
-> [[ModuleImport]] -> [ModuleImport]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
    [] -> []
    ModuleImport
x : [ModuleImport]
xs ->
      case ModuleImport -> ModuleImportStyle
moduleImportStyle ModuleImport
x of
        ModuleImportStyle
ModuleImportStyleOpen -> ModuleImport -> [ModuleImport]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleImport
x
        ModuleImportStyleExplicit [String]
ids ->
          ModuleImport -> [ModuleImport]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleImport
x
            { moduleImportStyle =
                ModuleImportStyleExplicit
                  $ List.sort
                  $ List.nub
                  $ ids <> idsFromModuleImportGroup (moduleImportStyle <$> xs)
            }
        ModuleImportStyleQualified {} -> ModuleImport -> [ModuleImport]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleImport
x

  idsFromModuleImportGroup :: [ModuleImportStyle] -> [String]
  idsFromModuleImportGroup :: [ModuleImportStyle] -> [String]
idsFromModuleImportGroup = (ModuleImportStyle -> [String]) -> [ModuleImportStyle] -> [String]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
    ModuleImportStyleExplicit [String]
ids -> [String]
ids
    ModuleImportStyle
_ -> []

  groupModuleImports :: ModuleImport -> ModuleImport -> Bool
  groupModuleImports :: ModuleImport -> ModuleImport -> Bool
groupModuleImports ModuleImport
x ModuleImport
y =
    ModuleImport -> String
moduleImportName ModuleImport
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleImport -> String
moduleImportName ModuleImport
y Bool -> Bool -> Bool
&&
      case (ModuleImport -> ModuleImportStyle
moduleImportStyle ModuleImport
x, ModuleImport -> ModuleImportStyle
moduleImportStyle ModuleImport
y) of
        (ModuleImportStyle
ModuleImportStyleOpen, ModuleImportStyle
ModuleImportStyleOpen) -> Bool
True
        (ModuleImportStyleExplicit {}, ModuleImportStyleExplicit {}) -> Bool
True
        (ModuleImportStyleQualified Maybe String
qx, ModuleImportStyleQualified Maybe String
qy) -> Maybe String
qx Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
qy
        (ModuleImportStyle
_, ModuleImportStyle
_) -> Bool
False

displayModule :: Module -> String
displayModule :: Module -> String
displayModule Module
m =
  [String] -> String
unlines
    ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"-- Auto-generated - do not manually modify!"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"{-# LANGUAGE ImportQualifiedPost #-}"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"module " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
moduleName
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"  ( " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n  , " [String]
moduleExports
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"  ) where"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
        [ [String] -> [String]
spacingIfNotNull [String]
openImportLines
        , [String] -> [String]
spacingIfNotNull [String]
explicitImportLines
        , [String] -> [String]
spacingIfNotNull [String]
qualifiedImportLines
        , [String] -> [String]
spacingIfNotNull [String]
moduleDeclarationLines
        ]
  where
  spacingIfNotNull :: [String] -> [String]
  spacingIfNotNull :: [String] -> [String]
spacingIfNotNull [String]
xs
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs = []
    | Bool
otherwise = [String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs]

  openImportLines :: [String]
  openImportLines :: [String]
openImportLines =
    [String]
openImports [String] -> (String -> String) -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
n -> String
"import " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n

  openImports :: [String]
  openImports :: [String]
openImports =
    [ModuleImport]
moduleImports [ModuleImport] -> ([ModuleImport] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& (ModuleImport -> Maybe String) -> [ModuleImport] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe \case
      ModuleImport { moduleImportName :: ModuleImport -> String
moduleImportName = String
n, moduleImportStyle :: ModuleImport -> ModuleImportStyle
moduleImportStyle = ModuleImportStyle
s }
        | ModuleImportStyle
ModuleImportStyleOpen <- ModuleImportStyle
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
n
      ModuleImport
_ -> Maybe String
forall a. Maybe a
Nothing

  explicitImportLines :: [String]
  explicitImportLines :: [String]
explicitImportLines =
    [(String, [String])]
explicitImports
      [(String, [String])]
-> ([(String, [String])] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& ((String, [String]) -> String) -> [(String, [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(String
n, [String]
xs) -> String
"import " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
xs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

  explicitImports :: [(String, [String])]
  explicitImports :: [(String, [String])]
explicitImports =
    [ModuleImport]
moduleImports [ModuleImport]
-> ([ModuleImport] -> [(String, [String])]) -> [(String, [String])]
forall a b. a -> (a -> b) -> b
& (ModuleImport -> Maybe (String, [String]))
-> [ModuleImport] -> [(String, [String])]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe \case
      ModuleImport { moduleImportName :: ModuleImport -> String
moduleImportName = String
n, moduleImportStyle :: ModuleImport -> ModuleImportStyle
moduleImportStyle = ModuleImportStyle
s }
        | ModuleImportStyleExplicit [String]
xs <- ModuleImportStyle
s -> (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
n, [String]
xs)
      ModuleImport
_ -> Maybe (String, [String])
forall a. Maybe a
Nothing

  qualifiedImportLines :: [String]
  qualifiedImportLines :: [String]
qualifiedImportLines =
    [(String, Maybe String)]
qualifiedImports
      [(String, Maybe String)]
-> ([(String, Maybe String)] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& ((String, Maybe String) -> String)
-> [(String, Maybe String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
          (String
n, Just String
q) ->  String
"import " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" qualified as " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
q
          (String
n, Maybe String
Nothing) ->  String
"import " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" qualified"

  qualifiedImports :: [(String, Maybe String)]
  qualifiedImports :: [(String, Maybe String)]
qualifiedImports =
    [ModuleImport]
moduleImports [ModuleImport]
-> ([ModuleImport] -> [(String, Maybe String)])
-> [(String, Maybe String)]
forall a b. a -> (a -> b) -> b
& (ModuleImport -> Maybe (String, Maybe String))
-> [ModuleImport] -> [(String, Maybe String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe \case
      ModuleImport { moduleImportName :: ModuleImport -> String
moduleImportName = String
n, moduleImportStyle :: ModuleImport -> ModuleImportStyle
moduleImportStyle = ModuleImportStyle
s }
        | ModuleImportStyleQualified Maybe String
q <- ModuleImportStyle
s -> (String, Maybe String) -> Maybe (String, Maybe String)
forall a. a -> Maybe a
Just (String
n, Maybe String
q)
      ModuleImport
_ -> Maybe (String, Maybe String)
forall a. Maybe a
Nothing

  moduleDeclarationLines :: [String]
  moduleDeclarationLines :: [String]
moduleDeclarationLines =
    [Int] -> [ModuleDeclaration] -> [(Int, ModuleDeclaration)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [ModuleDeclaration]
moduleDeclarations
      [(Int, ModuleDeclaration)]
-> ([(Int, ModuleDeclaration)] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& ((Int, ModuleDeclaration) -> String)
-> [(Int, ModuleDeclaration)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
          (Int
n, ModuleDeclaration Bool
_ (DeclName {}) (DeclBody String
body))
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 -> String
body
            | Bool
otherwise -> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
body

  Module
    { String
moduleName :: Module -> String
moduleName :: String
moduleName
    , [String]
moduleExports :: Module -> [String]
moduleExports :: [String]
moduleExports
    , [ModuleImport]
moduleImports :: Module -> [ModuleImport]
moduleImports :: [ModuleImport]
moduleImports
    , [ModuleDeclaration]
moduleDeclarations :: Module -> [ModuleDeclaration]
moduleDeclarations :: [ModuleDeclaration]
moduleDeclarations
    } = Module
m

type ModuleFragment :: Type
data ModuleFragment = ModuleFragment
  { ModuleFragment -> [ModuleImport]
moduleFragmentImports :: [ModuleImport]
  , ModuleFragment -> [ModuleDeclaration]
moduleFragmentDeclarations :: [ModuleDeclaration]
  } deriving stock (ModuleFragment -> ModuleFragment -> Bool
(ModuleFragment -> ModuleFragment -> Bool)
-> (ModuleFragment -> ModuleFragment -> Bool) -> Eq ModuleFragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleFragment -> ModuleFragment -> Bool
== :: ModuleFragment -> ModuleFragment -> Bool
$c/= :: ModuleFragment -> ModuleFragment -> Bool
/= :: ModuleFragment -> ModuleFragment -> Bool
Eq, Int -> ModuleFragment -> String -> String
[ModuleFragment] -> String -> String
ModuleFragment -> String
(Int -> ModuleFragment -> String -> String)
-> (ModuleFragment -> String)
-> ([ModuleFragment] -> String -> String)
-> Show ModuleFragment
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ModuleFragment -> String -> String
showsPrec :: Int -> ModuleFragment -> String -> String
$cshow :: ModuleFragment -> String
show :: ModuleFragment -> String
$cshowList :: [ModuleFragment] -> String -> String
showList :: [ModuleFragment] -> String -> String
Show)

instance Semigroup ModuleFragment where
  (<>) :: ModuleFragment -> ModuleFragment -> ModuleFragment
  ModuleFragment
mf1 <> :: ModuleFragment -> ModuleFragment -> ModuleFragment
<> ModuleFragment
mf2 =
    ModuleFragment
      { moduleFragmentImports :: [ModuleImport]
moduleFragmentImports = ModuleFragment -> [ModuleImport]
moduleFragmentImports ModuleFragment
mf1 [ModuleImport] -> [ModuleImport] -> [ModuleImport]
forall a. Semigroup a => a -> a -> a
<> ModuleFragment -> [ModuleImport]
moduleFragmentImports ModuleFragment
mf2
      , moduleFragmentDeclarations :: [ModuleDeclaration]
moduleFragmentDeclarations = ModuleFragment -> [ModuleDeclaration]
moduleFragmentDeclarations ModuleFragment
mf1 [ModuleDeclaration] -> [ModuleDeclaration] -> [ModuleDeclaration]
forall a. Semigroup a => a -> a -> a
<> ModuleFragment -> [ModuleDeclaration]
moduleFragmentDeclarations ModuleFragment
mf2
      }

instance Monoid ModuleFragment where
  mempty :: ModuleFragment
  mempty :: ModuleFragment
mempty =
    ModuleFragment
      { moduleFragmentImports :: [ModuleImport]
moduleFragmentImports = []
      , moduleFragmentDeclarations :: [ModuleDeclaration]
moduleFragmentDeclarations = []
      }

type ModuleExport :: Type
newtype ModuleExport = ModuleExport String
  deriving stock (ModuleExport -> ModuleExport -> Bool
(ModuleExport -> ModuleExport -> Bool)
-> (ModuleExport -> ModuleExport -> Bool) -> Eq ModuleExport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleExport -> ModuleExport -> Bool
== :: ModuleExport -> ModuleExport -> Bool
$c/= :: ModuleExport -> ModuleExport -> Bool
/= :: ModuleExport -> ModuleExport -> Bool
Eq, Int -> ModuleExport -> String -> String
[ModuleExport] -> String -> String
ModuleExport -> String
(Int -> ModuleExport -> String -> String)
-> (ModuleExport -> String)
-> ([ModuleExport] -> String -> String)
-> Show ModuleExport
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ModuleExport -> String -> String
showsPrec :: Int -> ModuleExport -> String -> String
$cshow :: ModuleExport -> String
show :: ModuleExport -> String
$cshowList :: [ModuleExport] -> String -> String
showList :: [ModuleExport] -> String -> String
Show)
  deriving newtype (String -> ModuleExport
(String -> ModuleExport) -> IsString ModuleExport
forall a. (String -> a) -> IsString a
$cfromString :: String -> ModuleExport
fromString :: String -> ModuleExport
IsString)

type ModuleImport :: Type
data ModuleImport = ModuleImport
  { ModuleImport -> String
moduleImportName :: String
  , ModuleImport -> ModuleImportStyle
moduleImportStyle :: ModuleImportStyle
  } deriving stock (ModuleImport -> ModuleImport -> Bool
(ModuleImport -> ModuleImport -> Bool)
-> (ModuleImport -> ModuleImport -> Bool) -> Eq ModuleImport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleImport -> ModuleImport -> Bool
== :: ModuleImport -> ModuleImport -> Bool
$c/= :: ModuleImport -> ModuleImport -> Bool
/= :: ModuleImport -> ModuleImport -> Bool
Eq, Eq ModuleImport
Eq ModuleImport =>
(ModuleImport -> ModuleImport -> Ordering)
-> (ModuleImport -> ModuleImport -> Bool)
-> (ModuleImport -> ModuleImport -> Bool)
-> (ModuleImport -> ModuleImport -> Bool)
-> (ModuleImport -> ModuleImport -> Bool)
-> (ModuleImport -> ModuleImport -> ModuleImport)
-> (ModuleImport -> ModuleImport -> ModuleImport)
-> Ord ModuleImport
ModuleImport -> ModuleImport -> Bool
ModuleImport -> ModuleImport -> Ordering
ModuleImport -> ModuleImport -> ModuleImport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModuleImport -> ModuleImport -> Ordering
compare :: ModuleImport -> ModuleImport -> Ordering
$c< :: ModuleImport -> ModuleImport -> Bool
< :: ModuleImport -> ModuleImport -> Bool
$c<= :: ModuleImport -> ModuleImport -> Bool
<= :: ModuleImport -> ModuleImport -> Bool
$c> :: ModuleImport -> ModuleImport -> Bool
> :: ModuleImport -> ModuleImport -> Bool
$c>= :: ModuleImport -> ModuleImport -> Bool
>= :: ModuleImport -> ModuleImport -> Bool
$cmax :: ModuleImport -> ModuleImport -> ModuleImport
max :: ModuleImport -> ModuleImport -> ModuleImport
$cmin :: ModuleImport -> ModuleImport -> ModuleImport
min :: ModuleImport -> ModuleImport -> ModuleImport
Ord, Int -> ModuleImport -> String -> String
[ModuleImport] -> String -> String
ModuleImport -> String
(Int -> ModuleImport -> String -> String)
-> (ModuleImport -> String)
-> ([ModuleImport] -> String -> String)
-> Show ModuleImport
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ModuleImport -> String -> String
showsPrec :: Int -> ModuleImport -> String -> String
$cshow :: ModuleImport -> String
show :: ModuleImport -> String
$cshowList :: [ModuleImport] -> String -> String
showList :: [ModuleImport] -> String -> String
Show)

type ModuleImportStyle :: Type
data ModuleImportStyle
  = ModuleImportStyleOpen
  | ModuleImportStyleExplicit [String]
  | ModuleImportStyleQualified (Maybe String)
  deriving stock (ModuleImportStyle -> ModuleImportStyle -> Bool
(ModuleImportStyle -> ModuleImportStyle -> Bool)
-> (ModuleImportStyle -> ModuleImportStyle -> Bool)
-> Eq ModuleImportStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleImportStyle -> ModuleImportStyle -> Bool
== :: ModuleImportStyle -> ModuleImportStyle -> Bool
$c/= :: ModuleImportStyle -> ModuleImportStyle -> Bool
/= :: ModuleImportStyle -> ModuleImportStyle -> Bool
Eq, Eq ModuleImportStyle
Eq ModuleImportStyle =>
(ModuleImportStyle -> ModuleImportStyle -> Ordering)
-> (ModuleImportStyle -> ModuleImportStyle -> Bool)
-> (ModuleImportStyle -> ModuleImportStyle -> Bool)
-> (ModuleImportStyle -> ModuleImportStyle -> Bool)
-> (ModuleImportStyle -> ModuleImportStyle -> Bool)
-> (ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle)
-> (ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle)
-> Ord ModuleImportStyle
ModuleImportStyle -> ModuleImportStyle -> Bool
ModuleImportStyle -> ModuleImportStyle -> Ordering
ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModuleImportStyle -> ModuleImportStyle -> Ordering
compare :: ModuleImportStyle -> ModuleImportStyle -> Ordering
$c< :: ModuleImportStyle -> ModuleImportStyle -> Bool
< :: ModuleImportStyle -> ModuleImportStyle -> Bool
$c<= :: ModuleImportStyle -> ModuleImportStyle -> Bool
<= :: ModuleImportStyle -> ModuleImportStyle -> Bool
$c> :: ModuleImportStyle -> ModuleImportStyle -> Bool
> :: ModuleImportStyle -> ModuleImportStyle -> Bool
$c>= :: ModuleImportStyle -> ModuleImportStyle -> Bool
>= :: ModuleImportStyle -> ModuleImportStyle -> Bool
$cmax :: ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle
max :: ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle
$cmin :: ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle
min :: ModuleImportStyle -> ModuleImportStyle -> ModuleImportStyle
Ord, Int -> ModuleImportStyle -> String -> String
[ModuleImportStyle] -> String -> String
ModuleImportStyle -> String
(Int -> ModuleImportStyle -> String -> String)
-> (ModuleImportStyle -> String)
-> ([ModuleImportStyle] -> String -> String)
-> Show ModuleImportStyle
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ModuleImportStyle -> String -> String
showsPrec :: Int -> ModuleImportStyle -> String -> String
$cshow :: ModuleImportStyle -> String
show :: ModuleImportStyle -> String
$cshowList :: [ModuleImportStyle] -> String -> String
showList :: [ModuleImportStyle] -> String -> String
Show)

type ModuleDeclaration :: Type
data ModuleDeclaration =
  ModuleDeclaration
    Bool -- ^ 'True' to export, 'False' to not export
    DeclName
    DeclBody
  deriving stock (ModuleDeclaration -> ModuleDeclaration -> Bool
(ModuleDeclaration -> ModuleDeclaration -> Bool)
-> (ModuleDeclaration -> ModuleDeclaration -> Bool)
-> Eq ModuleDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleDeclaration -> ModuleDeclaration -> Bool
== :: ModuleDeclaration -> ModuleDeclaration -> Bool
$c/= :: ModuleDeclaration -> ModuleDeclaration -> Bool
/= :: ModuleDeclaration -> ModuleDeclaration -> Bool
Eq, Int -> ModuleDeclaration -> String -> String
[ModuleDeclaration] -> String -> String
ModuleDeclaration -> String
(Int -> ModuleDeclaration -> String -> String)
-> (ModuleDeclaration -> String)
-> ([ModuleDeclaration] -> String -> String)
-> Show ModuleDeclaration
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ModuleDeclaration -> String -> String
showsPrec :: Int -> ModuleDeclaration -> String -> String
$cshow :: ModuleDeclaration -> String
show :: ModuleDeclaration -> String
$cshowList :: [ModuleDeclaration] -> String -> String
showList :: [ModuleDeclaration] -> String -> String
Show)

type DeclName :: Type
newtype DeclName = DeclName String
  deriving stock (DeclName -> DeclName -> Bool
(DeclName -> DeclName -> Bool)
-> (DeclName -> DeclName -> Bool) -> Eq DeclName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclName -> DeclName -> Bool
== :: DeclName -> DeclName -> Bool
$c/= :: DeclName -> DeclName -> Bool
/= :: DeclName -> DeclName -> Bool
Eq, Int -> DeclName -> String -> String
[DeclName] -> String -> String
DeclName -> String
(Int -> DeclName -> String -> String)
-> (DeclName -> String)
-> ([DeclName] -> String -> String)
-> Show DeclName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DeclName -> String -> String
showsPrec :: Int -> DeclName -> String -> String
$cshow :: DeclName -> String
show :: DeclName -> String
$cshowList :: [DeclName] -> String -> String
showList :: [DeclName] -> String -> String
Show)
  deriving newtype (String -> DeclName
(String -> DeclName) -> IsString DeclName
forall a. (String -> a) -> IsString a
$cfromString :: String -> DeclName
fromString :: String -> DeclName
IsString)

type DeclBody :: Type
newtype DeclBody = DeclBody String
  deriving stock (DeclBody -> DeclBody -> Bool
(DeclBody -> DeclBody -> Bool)
-> (DeclBody -> DeclBody -> Bool) -> Eq DeclBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclBody -> DeclBody -> Bool
== :: DeclBody -> DeclBody -> Bool
$c/= :: DeclBody -> DeclBody -> Bool
/= :: DeclBody -> DeclBody -> Bool
Eq, Int -> DeclBody -> String -> String
[DeclBody] -> String -> String
DeclBody -> String
(Int -> DeclBody -> String -> String)
-> (DeclBody -> String)
-> ([DeclBody] -> String -> String)
-> Show DeclBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DeclBody -> String -> String
showsPrec :: Int -> DeclBody -> String -> String
$cshow :: DeclBody -> String
show :: DeclBody -> String
$cshowList :: [DeclBody] -> String -> String
showList :: [DeclBody] -> String -> String
Show)
  deriving newtype (String -> DeclBody
(String -> DeclBody) -> IsString DeclBody
forall a. (String -> a) -> IsString a
$cfromString :: String -> DeclBody
fromString :: String -> DeclBody
IsString)