{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.PureScript.Bridge (
bridgeSumType
, defaultBridge
, module Bridge
, writePSTypes
, writePSTypesWith
, defaultSwitch, noLenses, genLenses
) where
import Control.Applicative
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text.IO as T
import Language.PureScript.Bridge.Builder as Bridge
import Language.PureScript.Bridge.Primitives as Bridge
import Language.PureScript.Bridge.Printer as Bridge
import Language.PureScript.Bridge.SumType as Bridge
import Language.PureScript.Bridge.Tuple as Bridge
import Language.PureScript.Bridge.TypeInfo as Bridge
import Language.PureScript.Bridge.CodeGenSwitches as Switches
writePSTypes :: FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypes :: FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypes = Switch -> FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypesWith Switch
Switches.defaultSwitch
writePSTypesWith :: Switches.Switch -> FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypesWith :: Switch -> FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypesWith Switch
switch FilePath
root FullBridge
bridge [SumType 'Haskell]
sts = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Settings -> FilePath -> PSModule -> IO ()
printModule Settings
settings FilePath
root) [PSModule]
modules
Text -> IO ()
T.putStrLn Text
"The following purescript packages are needed by the generated code:\n"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Text
" - ") Set Text
packages
Text -> IO ()
T.putStrLn Text
"\nSuccessfully created your PureScript modules!"
where
settings :: Settings
settings = Switch -> Settings
Switches.getSettings Switch
switch
bridged :: [SumType 'PureScript]
bridged = forall a b. (a -> b) -> [a] -> [b]
map (FullBridge -> SumType 'Haskell -> SumType 'PureScript
bridgeSumType FullBridge
bridge) [SumType 'Haskell]
sts
modules :: [PSModule]
modules = forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ Modules -> [SumType 'PureScript] -> Modules
sumTypesToModules forall k a. Map k a
M.empty [SumType 'PureScript]
bridged
packages :: Set Text
packages =
if Settings -> Bool
Switches.generateLenses Settings
settings then
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
"purescript-profunctor-lenses" forall a b. (a -> b) -> a -> b
$ forall (lang :: Language). [SumType lang] -> Set Text
sumTypesToNeededPackages [SumType 'PureScript]
bridged
else
forall (lang :: Language). [SumType lang] -> Set Text
sumTypesToNeededPackages [SumType 'PureScript]
bridged
bridgeSumType :: FullBridge -> SumType 'Haskell -> SumType 'PureScript
bridgeSumType :: FullBridge -> SumType 'Haskell -> SumType 'PureScript
bridgeSumType FullBridge
br (SumType TypeInfo 'Haskell
t [DataConstructor 'Haskell]
cs [Instance]
is) = forall (lang :: Language).
TypeInfo lang
-> [DataConstructor lang] -> [Instance] -> SumType lang
SumType (FullBridge
br TypeInfo 'Haskell
t) (forall a b. (a -> b) -> [a] -> [b]
map (FullBridge
-> DataConstructor 'Haskell -> DataConstructor 'PureScript
bridgeConstructor FullBridge
br) [DataConstructor 'Haskell]
cs) [Instance]
is
defaultBridge :: BridgePart
defaultBridge :: BridgePart
defaultBridge = BridgePart
textBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
stringBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
listBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
maybeBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
eitherBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
strMapBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
boolBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
intBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
doubleBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
tupleBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
unitBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
noContentBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
wordBridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
word8Bridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
word16Bridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
word32Bridge
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
word64Bridge
bridgeConstructor :: FullBridge -> DataConstructor 'Haskell -> DataConstructor 'PureScript
bridgeConstructor :: FullBridge
-> DataConstructor 'Haskell -> DataConstructor 'PureScript
bridgeConstructor FullBridge
br (DataConstructor Text
name (Left [TypeInfo 'Haskell]
infos)) =
forall (lang :: Language).
Text
-> Either [TypeInfo lang] [RecordEntry lang]
-> DataConstructor lang
DataConstructor Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FullBridge
br [TypeInfo 'Haskell]
infos
bridgeConstructor FullBridge
br (DataConstructor Text
name (Right [RecordEntry 'Haskell]
record)) =
forall (lang :: Language).
Text
-> Either [TypeInfo lang] [RecordEntry lang]
-> DataConstructor lang
DataConstructor Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FullBridge -> RecordEntry 'Haskell -> RecordEntry 'PureScript
bridgeRecordEntry FullBridge
br) [RecordEntry 'Haskell]
record
bridgeRecordEntry :: FullBridge -> RecordEntry 'Haskell -> RecordEntry 'PureScript
bridgeRecordEntry :: FullBridge -> RecordEntry 'Haskell -> RecordEntry 'PureScript
bridgeRecordEntry FullBridge
br (RecordEntry Text
label TypeInfo 'Haskell
value) = forall (lang :: Language).
Text -> TypeInfo lang -> RecordEntry lang
RecordEntry Text
label forall a b. (a -> b) -> a -> b
$ FullBridge
br TypeInfo 'Haskell
value