tidy-codegen livecoding example

ExampleWalkthrough.purs

module CodegenWalkthrough where

import Prelude

import Control.Alternative (guard)
import Control.Monad.Writer (tell)
import Data.Array as Array
import Data.Foldable (for_)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..), snd)
import Effect (Effect)
import Effect.Class.Console as Console
import Partial.Unsafe (unsafeCrashWith, unsafePartial)
import PureScript.CST (RecoveredParserResult(..), parseModule)
import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)
import PureScript.CST.Types (DataCtor(..), Declaration(..), Module(..), ModuleHeader(..), Name(..), Proper(..), Separated(..))
import PureScript.CST.Types as CST
import Tidy.Codegen (binderCtor, binderVar, binderWildcard, caseBranch, declSignature, declValue, docComments, exprApp, exprCase, exprCtor, exprIdent, exprSection, exprString, leading, lineBreaks, printModule, typeApp, typeArrow, typeCtor, typeWildcard)
import Tidy.Codegen.Monad (Codegen, codegenModule, exporting, importCtor, importFrom, importOpen, importType, importValue)
import Tidy.Codegen.Types (Qualified(..))

source :: String
source = """
module PrismExample where
data Val = ValString String | ValInt Int | ValBool Boolean
"""

testModule :: Partial => Module Void -> Codegen Void Unit
testModule mod@(Module { header: ModuleHeader { name: modName } }) = do
  let
    constructors = mod # foldMapModule defaultMonoidalVisitor
      { onDecl = case _ of
          DeclData { name: typeName, vars: [] } (Just (Tuple _ (Separated { head, tail }))) ->
            (Array.cons head (map snd tail))
              # Array.mapMaybe \(DataCtor { fields, name }) -> do
                  field <- Array.head fields
                  guard (Array.length fields == 1)
                  pure
                    { field
                    , name
                    , typeName
                    }
          _ ->
            []
      }

  exporting do
    for_ constructors \{ field, name: Name { name }, typeName } -> do
      _ <- importFrom (unwrap modName).name (importCtor typeName (unwrap name))
      dataMaybe <- importFrom "Data.Maybe"
        { just: importCtor "Maybe" "Just"
        , nothing: importCtor "Maybe" "Nothing"
        }
      dataLens <- importFrom "Data.Lens"
        { prismType: importType "Prism'"
        , prism: importValue "prism'"
        }
      tell
        [ declSignature ("_" <> unwrap name) do
            typeApp (typeCtor dataLens.prismType)
              [ typeCtor typeName
              , field
              ]
        , declValue ("_" <> unwrap name) [] do
            exprApp (exprIdent dataLens.prism)
              [ exprCtor name
              , exprCase [ exprSection ]
                  [ caseBranch [ binderCtor name [ binderVar "value" ] ] do
                      leading (lineBreaks 1) do
                        exprApp (exprCtor dataMaybe.just)
                          [ exprIdent "value" ]
                  , caseBranch [ binderWildcard ] do
                      exprCtor dataMaybe.nothing
                  ]
              ]
        ]

main :: Effect Unit
main =
  case parseModule source of
    ParseSucceeded mod ->
      Console.log $ printModule $ unsafePartial do
        codegenModule "PrismExample.Optics" $ testModule mod
    _ ->
      unsafeCrashWith "Oops"