{-# 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

-- | Your entry point to this library and quite likely all you will need.
--   Make sure all your types derive `Generic` and `Typeable`.
--   Typeable is not needed from ghc-7.10 on.
--
--   Then list all your types you want to use in PureScript and call 'writePSTypes':
--
--   > data Foo = Foo { ... } deriving (Eq, Generic)
--   > data Bar = A | B | C deriving (Eq, Ord, Generic)
--   > data Baz = ... deriving (Generic)
--   >
--   > -- | All types will have a `Generic` instance produced in Purescript.
--   > myTypes :: [SumType 'Haskell]
--   > myTypes =
--   >   [ let p = (Proxy :: Proxy Foo) in equal p (mkSumType p)  -- Also produce a `Eq` instance.
--   >   , let p = (Proxy :: Proxy Bar) in order p (mkSumType p)  -- Produce both `Eq` and `Ord`.
--   >   , mkSumType (Proxy :: Proxy Baz)  -- Just produce a `Generic` instance.
--   >   ]
--   >
--   >  writePSTypes "path/to/your/purescript/project" (buildBridge defaultBridge) myTypes
--
--   You can define your own type bridges based on 'defaultBridge':
--
--
--  >  myBridge = defaultBridge <|> mySpecialTypeBridge
--
--  and use it with 'writePSTypes':
--
--  >  writePSTypes "path/to/your/purescript/project" (buildBridge myBridge) myTypes
--
--   Find examples for implementing your own bridges in: "Language.PureScript.Bridge.Primitives".
--
--  == Result:
--   'writePSTypes' will write out PureScript modules to the given path, mirroring the hierarchy of the Haskell modules
--   the types came from. In addition a list of needed PS packages is printed to the console.
--
--   The list of needed packages is retrieved from the bridged 'TypeInfo' data, so make sure you set '_typePackage' correctly
--   in your own bridges, in order for this feature to be useful.
--
--  == Real world usage example (at time of this writing outdated, at time of reading hopefully fixed):
--   A real world use case of this library can be found <https://github.com/gonimo/gonimo-back/blob/master/app/PSGenerator.hs here>.
--
--   With custom bridges defined <https://github.com/gonimo/gonimo-back/blob/master/src/Gonimo/CodeGen/TypeBridges.hs here> and
--   custom PS types defined <https://github.com/gonimo/gonimo-back/blob/master/src/Gonimo/CodeGen/PSTypes.hs here>.
--
--   Parts of the generated output can be found <https://github.com/gonimo/gonimo-front/blob/master/src/Gonimo/Types.purs here>.
--
--   Note how 'Secret' and 'Key'
--   get translated according to our custom rules, with correct imports and everything.
--   Also the formatting is quite nice, would you have guessed that this code was generated?
--
--  == /WARNING/:
--   This function overwrites files - make backups or use version control!
writePSTypes :: FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypes :: FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypes = Switch -> FilePath -> FullBridge -> [SumType 'Haskell] -> IO ()
writePSTypesWith Switch
Switches.defaultSwitch


-- | Works like `writePSTypes` but you can add additional switches to control the generation of your PureScript code
--
--  == Switches/Settings:
--
--   - `noLenses` and `genLenses` to control if the `purescript-profunctor-lenses` are generated for your types
--
--  == /WARNING/:
--   This function overwrites files - make backups or use version control!
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


-- | Translate all 'TypeInfo' values in a 'SumType' to PureScript types.
--
--   Example usage, with defaultBridge:
--
-- > data Foo = Foo | Bar Int | FooBar Int Text deriving (Generic, Typeable, Show)
--
-- > bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy Foo))
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

-- | Default bridge for mapping primitive/common types:
--   You can append your own bridges like this:
--
-- >  defaultBridge <|> myBridge1 <|> myBridge2
--
--   Find examples for bridge definitions in "Language.PureScript.Bridge.Primitives" and
--   "Language.PureScript.Bridge.Tuple".
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

-- | Translate types in a constructor.
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

-- | Translate types in a record entry.
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