lcc/Hcompta/LCC/Chart/Test.hs

   1 module Chart.Test where
   2
   3 import Test.Tasty
   4 import Test.Tasty.HUnit
   5
   6 import Control.Monad (join)
   7 import Data.Bool
   8 import Data.Char (Char)
   9 import Data.Either (Either(..))
  10 import Data.Function (($), (.))
  11 import Data.Functor ((<$>))
  12 import Data.NonNull (NonNull)
  13 import Data.Proxy
  14 import Data.Text (Text)
  15 import Data.TreeMap.Strict.Zipper
  16 import Data.Tuple (fst)
  17 import System.FilePath.Posix ((</>))
  18 import System.IO (IO, FilePath)
  19 import qualified Data.NonNull as NonNull
  20 import qualified System.Directory as IO
  21 import qualified System.IO.Memoize as IO
  22 import qualified Text.Megaparsec as P
  23 -- import Control.Applicative (Applicative(..))
  24 -- import Control.Monad.IO.Class (MonadIO(..))
  25 -- import Data.Functor.Identity (Identity(..))
  26 -- import Data.Maybe (isJust)
  27 -- import Prelude (error)
  28 -- import Text.Show (show)
  29 -- import qualified Data.List as List
  30 -- import qualified Data.Map.Strict as Map
  31 -- import qualified Data.Strict as S
  32 -- import qualified Data.Text as Text
  33 -- import qualified Data.Text.IO as Text.IO
  34 -- import qualified Data.TreeMap.Strict as TreeMap
  35
  36 -- import qualified Hcompta as H
  37 import qualified Hcompta.LCC as LCC
  38 import qualified Language.Symantic as Sym
  39 import qualified Language.Symantic.Lib ()
  40
  41 type Ifaces = '[Proxy (->)]
  42
  43 chart_from_file :: FilePath -> IO (Either (P.ParseError Char P.Dec) LCC.Chart)
  44 chart_from_file file = do
  45         cwd <- IO.getCurrentDirectory
  46         (fst . fst <$>) $ -- NOTE: drop final contexts.
  47                 LCC.read_file (cwd </> file) $
  48                         LCC.read @Ifaces @[LCC.Transaction] $
  49                                 LCC.g_get $ (\_j chart -> chart) <$> -- NOTE: get Chart from final context.
  50                                 LCC.g_journal
  51                                  @(Sym.TyConsts_of_Ifaces Ifaces)
  52                                  @Ifaces
  53                                  @[LCC.Transaction]
  54                                  (:)
  55
  56 chart_00 :: (FilePath, IO (Either (P.ParseError Char P.Dec) LCC.Chart))
  57 chart_00 = (file,) $ join $ IO.once $ chart_from_file file
  58         where file = "Hcompta/LCC/Chart/chart.00.lcc"
  59 chart_01 :: (FilePath, IO (Either (P.ParseError Char P.Dec) LCC.Chart))
  60 chart_01 = (file,) $ join $ IO.once $ chart_from_file file
  61         where file = "Hcompta/LCC/Chart/chart.01.lcc"
  62
  63 tag_path :: [Text] -> LCC.Tag_Path
  64 tag_path p = LCC.Tag_Path $ NonNull.impureNonNull (LCC.Name <$> p)
  65
  66 zip_path :: [Text] -> NonNull [LCC.Name]
  67 zip_path p = NonNull.impureNonNull (LCC.Name <$> p)
  68
  69 tests :: TestTree
  70 tests = testGroup "Chart"
  71  [ testGroup "chart_axis_child" $
  72         let (==>) (file, input) expected =
  73                 testCase file $ do
  74                         lr_chart <- input
  75                         let path = do
  76                                 chart <- lr_chart
  77                                 let sel = zipper_child
  78                                 let res = sel $ LCC.zipper_chart chart
  79                                 Right $ (LCC.unName <$>) . path_of_zipper <$> res
  80                         path @?= Right expected in
  81          [ chart_00 ==>
  82                  [ ["1.Capital"]
  83                  , ["2.Immobilisation"]
  84                  , ["3.Stock"]
  85                  , ["4.Tiers"]
  86                  , ["5.Finance"]
  87                  , ["6.Charge"]
  88                  , ["7.Produit"]
  89                  ]
  90          ]
  91  , testGroup "chart_axis_descendant" $
  92         let (==>) (file, input) expected =
  93                 testCase file $ do
  94                         lr_chart <- input
  95                         let path = do
  96                                 chart <- lr_chart
  97                                 let sel = zipper_descendant
  98                                 let res = sel $ LCC.zipper_chart chart
  99                                 Right $ (LCC.unName <$>) . path_of_zipper <$> res
 100                         path @?= Right expected in
 101          [ chart_00 ==>
 102                  [ ["1.Capital"]
 103                  , ["2.Immobilisation"]
 104                  , ["3.Stock"]
 105                  , ["4.Tiers"]
 106                  , ["4.Tiers", "0.Fournisseur"]
 107                  , ["4.Tiers", "0.Fournisseur", "9.Débiteur"]
 108                  , ["4.Tiers", "1.Client"]
 109                  , ["4.Tiers", "2.Personnel"]
 110                  , ["4.Tiers", "3.Sécu"]
 111                  , ["4.Tiers", "4.État"]
 112                  , ["5.Finance"]
 113                  , ["5.Finance", "1.Établissement"]
 114                  , ["5.Finance", "1.Établissement", "2.Banque"]
 115                  , ["5.Finance", "3.Caisse"]
 116                  , ["6.Charge"]
 117                  , ["7.Produit"]
 118                  ]
 119          ]
 120  , testGroup "zipper_account_tags" $
 121         let (==>) (file, input) expected =
 122                 testCase file $ do
 123                         lr_chart <- input
 124                         let path = do
 125                                 chart <- lr_chart
 126                                 let sel =
 127                                  -- //*[...[~Bilan][0][~Bilan:Actif]]
 128                                         zipper_descendant
 129                                         `zipper_filter` not . zipper_null
 130                                          (zipper_ancestor_or_self
 131                                                 `zipper_filter` not . zipper_null
 132                                                  (zipper_child_lookup $ LCC.Name "Bilan")
 133                                                  . LCC.zipper_accounts_tags
 134                                                 `zipper_at` 0
 135                                                 `zipper_filter` not . zipper_null
 136                                                  (zipper_child_lookups $ zip_path ["Bilan", "Actif"])
 137                                                  . LCC.zipper_accounts_tags)
 138                                 let res = sel $ zipper $ LCC.chart_accounts chart
 139                                 Right $ (LCC.unName <$>) . path_of_zipper <$> res
 140                         path @?= Right expected in
 141          [ chart_00 ==>
 142                  [ ["2.Immobilisation"]
 143                  , ["4.Tiers","0.Fournisseur","9.Débiteur"]
 144                  , ["4.Tiers","1.Client"]
 145                  , ["4.Tiers","3.Sécu"]
 146                  ]
 147          ]
 148  ]